COBOL : comment faire une pause dans le programme ?

COBOL : comment faire une pause dans le programme ? - Divers - Programmation

Marsh Posté le 10-11-2003 à 10:57:04    

salut all
 
savez vous comment faire une pause dans un prog cobol?
 
un équivalent du "delay(int)" en c par exemple
 
merci :hello:  
 
ps : cobol powaaaa [:thesphax]


Message édité par schumacher le 10-11-2003 à 10:58:03
Reply

Marsh Posté le 10-11-2003 à 10:57:04   

Reply

Marsh Posté le 10-11-2003 à 13:58:08    

Apparement, c'est pas dans le standard, mais ca peut faire partie des extensions propre a chaque plate-forme.
 
Là, un exemple trouvé sur le web, en Cobol sur machine Wang.
 

Code :
  1. This program performs a five-second pause in processing.
  3. 000100* Module CPAUSE Version xx.xx.xx Added by SCS on 06/12/XX
  4. 000200 IDENTIFICATION DIVISION.
  5. 000300 PROGRAM-ID. CPAUSE.
  6. 000400 ENVIRONMENT DIVISION.
  7. 000500 DATA DIVISION.
  8. 000600 WORKING-STORAGE SECTION.
  9. 000700 01 PAUSE-TIME PIC S9(09) BINARY VALUE 500.
  10. 001000
  11. 001100 77 FIRST-MESSAGE PIC X(70) VALUE "STARTING PAUSE
  12. 001200- "FOR 5 SECONDS.".
  13. 001300
  14. 001400 77 SECOND-MESSAGE PIC X(70) VALUE "PAUSE COMPLETE.".
  15. 001500
  16. 001600 PROCEDURE DIVISION.
  17. 001700 MAIN-PARAGRAPH.
  18. 001800 DISPLAY FIRST-MESSAGE.
  19. 001900 CALL "PAUSE" USING PAUSE-TIME.
  20. 002000 DISPLAY SECOND-MESSAGE.
  21. 002100 STOP RUN.


 
A+,


Message édité par gilou le 10-11-2003 à 13:59:00

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 13:58:57    

putain, c'est ça du cobol ? [:mlc]


---------------
J'ai un string dans l'array (Paris Hilton)
Reply

Marsh Posté le 10-11-2003 à 13:59:58    

J'y connais pas grand chose moi non plus.
 
Il y a une bonne introduction a ce langage ici: http://www.csis.ul.ie/cobol/Course/COBOLIntro.htm
 
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 14:05:43    

Harkonnen a écrit :

putain, c'est ça du cobol ? [:mlc]


 
Oui, c'est pire que le PHP hein :D


---------------
mes programmes ·· les voitures dans les films ·· apprenez à écrire
Reply

Marsh Posté le 10-11-2003 à 14:07:52    

antp a écrit :


 
Oui, c'est pire que le PHP hein :D


ouaip, pourtant je pensais pas qu'on pouvait faire pire !
ah si, peut etre avec Windev :D


---------------
J'ai un string dans l'array (Paris Hilton)
Reply

Marsh Posté le 10-11-2003 à 14:14:32    

Heu on peut faire pire que Cobol encore :
http://pr.fujitsu.com/jp/news/1997/Sep/netcobol.html
du Cobol sur le web :D


---------------
mes programmes ·· les voitures dans les films ·· apprenez à écrire
Reply

Marsh Posté le 10-11-2003 à 14:14:53    

Harkonnen a écrit :

putain, c'est ça du cobol ? [:mlc]


Non, c'est pas du cobol çà ! C'est juste un prog qui fait rien !
 
Un vrai programme COBOL çà fait plusieurs centaines de pages de listing dont un bon tiers de déclarations.
 
Le listing du plus gros prog sur lequel j'ai bossé faisait dans les 50 Cm d'épaisseur :D  
 
C'est imbitable pour le commun des programmeurs et c'est pas du tout adapté à la visu sur écran PC.
 
Pour faire un cobol, il faut soit un écran passif, soit un lecteurs de cartes perforés !
 
Bref, c'est pas encore mort mais y'a très longtemps que çà devrait l'être :fou:


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 14:18:43    

antp a écrit :

Heu on peut faire pire que Cobol encore :
http://pr.fujitsu.com/jp/news/1997/Sep/netcobol.html
du Cobol sur le web :D


m'enfin [:marc]


---------------
J'ai un string dans l'array (Paris Hilton)
Reply

Marsh Posté le 10-11-2003 à 14:19:20    

Mara's dad a écrit :


Bref, c'est pas encore mort mais y'a très longtemps que çà devrait l'être :fou:  


un peu comme la disquette quoi :D


---------------
J'ai un string dans l'array (Paris Hilton)
Reply

Marsh Posté le 10-11-2003 à 14:19:20   

Reply

Marsh Posté le 10-11-2003 à 14:20:50    

Citation :

NetCOBOL Key Features
 
    * Generates 100% Pure Java Bytecode
    * COBOL programs can run as either a Java applet or Java application (COBOL applets subject to Java applet security)
    * Standards Compliant (Full ANSI Standard COBOL X3.23B 1989)
    * Platform independent Event Driven GUI programming extensions
    * Embedded SQL Preprocessor with JDBC support, facilitating the creation of COBOL applications/applets that can access data on DB2, Oracle, Sybase, SQL Server and other database servers.
    * Java based & network accessible COBOL file systems (Sequential, Relative, and Index)
    * EXEC HTML - allows dynamic COBOL driven web pages
    * EXEC JAVA - allows mixture of COBOL and Java source code in the same program
    * TCP/IP socket programming extensions


[:mlc]


---------------
Can't buy what I want because it's free -
Reply

Marsh Posté le 10-11-2003 à 14:23:41    

Citation :

* EXEC JAVA - allows mixture of COBOL and Java source code in the same program


Tu parles d'une mixture :lol:


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 14:28:02    

Mara's dad a écrit :


Non, c'est pas du cobol çà ! C'est juste un prog qui fait rien !
 
Un vrai programme COBOL çà fait plusieurs centaines de pages de listing dont un bon tiers de déclarations.
 
Le listing du plus gros prog sur lequel j'ai bossé faisait dans les 50 Cm d'épaisseur :D  
 
C'est imbitable pour le commun des programmeurs et c'est pas du tout adapté à la visu sur écran PC.
 
Pour faire un cobol, il faut soit un écran passif, soit un lecteurs de cartes perforés !
 
Bref, c'est pas encore mort mais y'a très longtemps que çà devrait l'être :fou:  


Dans l'introduction du lien filé a Harko(bol?) :D [la mise en rouge est de moi :D]
 

Citation :

For over four decades COBOL has been the dominant programming language in the business computing domain. In that time it it has seen off the challenges of a number of other languages such as PL1, Algol68, Pascal, Modula, Ada, C, C++. All these languages have found a niche but none has yet displaced COBOL. Two recent challengers though, Java and Visual Basic, are proving to be serious contenders.
 
COBOL's dominance in underlined by the reports from the Gartner group.  
 
In 1997 they estimated that there were about 300 billion lines of computer code in use in the world. Of that they estimated that about 80% (240 billion lines) were in COBOL and 20% (60 billion lines) were written in all the other computer languages combined [Brown].  
 
In 1999 they reported that over 50% of all new mission-critical applications were still being done in COBOL and their recent estimates indicate that through 2004-2005 15% of all new applications (5 billion lines) will be developed in COBOL while 80% of all deployed applications will include extensions to existing legacy (usually COBOL) programs.  
 
Gartner estimates for 2002 are that there are about two million COBOL programmers world-wide compared to about about one million Java programmers and one million C++ programmers.


A+,


Message édité par gilou le 10-11-2003 à 14:28:27

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 14:33:39    

gilou a écrit :


Dans l'introduction du lien filé a Harko(bol?) :D [la mise en rouge est de moi :D]
 

Citation :


In 1997 they estimated that there were about 300 billion lines of computer code in use in the world. Of that they estimated that about 80% (240 billion lines) were in COBOL and 20% (60 billion lines) were written in all the other computer languages combined [Brown].




Tu m'étonnes, vu la syntaxe du bouzin, un prog de moins de 5000 lignes risque pas de servir à grand-chose![:joce]


---------------
Can't buy what I want because it's free -
Reply

Marsh Posté le 10-11-2003 à 14:49:11    

C'est le problème, comparer le nombre de lignes veux pas dire grand chose !
 
En plus y doivent pas compter l'assembleur, sinon, on explose les compteurs :D


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 16:36:46    

skeye a écrit :


Tu m'étonnes, vu la syntaxe du bouzin, un prog de moins de 5000 lignes risque pas de servir à grand-chose![:joce]

:non: la preuve qu'il faut pas 5000 lignes minimum:

Code :
  1. 000100 IDENTIFICATION DIVISION.
  2. 000200 PROGRAM-ID.     HELLOWORLD.
  3. 000300
  4. 000400*
  5. 000500 ENVIRONMENT DIVISION.
  6. 000600 CONFIGURATION SECTION.
  7. 000700 SOURCE-COMPUTER. RM-COBOL.
  8. 000800 OBJECT-COMPUTER. RM-COBOL.
  9. 000900
  10. 001000 DATA DIVISION.
  11. 001100 FILE SECTION.
  12. 001200
  13. 100000 PROCEDURE DIVISION.
  14. 100100
  15. 100200 MAIN-LOGIC SECTION.
  16. 100300 BEGIN.
  17. 100400     DISPLAY " " LINE 1 POSITION 1 ERASE EOS.
  18. 100500     DISPLAY "Hello world!" LINE 15 POSITION 10.
  19. 100600     STOP RUN.
  20. 100700 MAIN-LOGIC-EXIT.
  21. 100800     EXIT.


:D
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 17:04:23    

antp a écrit :


 
Oui, c'est pire que le PHP hein :D

keske t'as contre le php ? :o


---------------
lecteur mp3 yvele's smilies jeux de fille
Reply

Marsh Posté le 10-11-2003 à 17:55:36    

Moi, rien, c'est Harko :o


---------------
mes programmes ·· les voitures dans les films ·· apprenez à écrire
Reply

Marsh Posté le 10-11-2003 à 17:59:33    

Mara's dad a écrit :


En plus y doivent pas compter l'assembleur, sinon, on explose les compteurs :D


on peut coller de l'assembleur dans ce bordel ? [:xx_xx]


---------------
J'ai un string dans l'array (Paris Hilton)
Reply

Marsh Posté le 10-11-2003 à 18:01:43    

Harkonnen a écrit :


on peut coller de l'assembleur dans ce bordel ? [:xx_xx]


 
ouais avec la syntaxe cobol bien sur [:dawa]
 
 
ASM-SECTION
ALIGNEMENT NONE
MOVE EBX TO EAX
CALL EBX  
PREPARE FOOD FOR THE CAT

Reply

Marsh Posté le 10-11-2003 à 18:10:12    

est ce que tout les programmeurs cobol ont la touche caplock bloqué? [:dawa]


---------------
lecteur mp3 yvele's smilies jeux de fille
Reply

Marsh Posté le 10-11-2003 à 19:55:27    

forummp3 a écrit :

est ce que tout les programmeurs cobol ont la touche caplock bloqué? [:dawa]


YES, EN COBOL TOUS LES MOTS CLEF SONT EN MAJ.
TOUS LES NOMS SYMBOLIQUES SONT AUSSI EN MAJ.
BREF, LES CARACTERES AUTORISES SONR TRES RESTEINTS.


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 20:05:25    

C4EST UN COUP A DEVENIR HISTERIQUE CETTE HISTOIRE DE CAPLOCK BLOQU2 /D


---------------
lecteur mp3 yvele's smilies jeux de fille
Reply

Marsh Posté le 10-11-2003 à 20:06:55    

A ton avis pourquoi plus personne ne veut en faire ?


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 20:09:04    

ILS ONT CASS2 LE CAPLOCK A FORCE ? [/DAWA]


---------------
lecteur mp3 yvele's smilies jeux de fille
Reply

Marsh Posté le 10-11-2003 à 22:47:31    

Mara's dad a écrit :

A ton avis pourquoi plus personne ne veut en faire ?


 
Faut dire que des que tu regardes de pres un programme, :sweat: ca fait vraiment archaique.
 
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 22:50:03    

Mara's dad a écrit :

A ton avis pourquoi plus personne ne veut en faire ?


 
Parceque ras le bol de mettre une * en colonne 7 pour signaler un commentaire


Message édité par kadreg le 10-11-2003 à 22:50:18

---------------
brisez les rêves des gens, il en restera toujours quelque chose...  -- laissez moi troller sur discu !
Reply

Marsh Posté le 10-11-2003 à 22:54:26    

gilou a écrit :


 
Faut dire que des que tu regardes de pres un programme, :sweat: ca fait vraiment archaique.
 
A+,


rien que les numéros de ligne, on se croirait sur Apple II :D


---------------
J'ai un string dans l'array (Paris Hilton)
Reply

Marsh Posté le 10-11-2003 à 23:18:23    

Le cobol, c'est tres lisible par rapport au JCL, IMHO.
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 23:19:52    

Quoi, le JCL c'est limpide comme tout !
Trop puissant ce truc :D


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 23:22:31    

Hem...
 

Code :
  1. //PDCRTSJ2 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
  2. //* *******************************************************************
  3. //*                   This program is provided by:                    *
  4. //*                    SimoTime Enterprises, LLC                      *
  5. //*           (C) Copyright 1987-2003 All Rights Reserved             *
  6. //*                                                                   *
  7. //*             Web Site URL:   http://www.simotime.com               *
  8. //*                   e-mail:   helpdesk@simotime.com                 *
  9. //* *******************************************************************
  10. //*
  11. //* Subject: Define a PDS using the IEFBR14 with a DD Statement
  12. //* Author:  SimoTime Enterprises
  13. //* Date:    January 1,1998
  14. //*
  15. //* Technically speaking, IEFBR14 is not a utility program because it
  16. //* does nothing. The name is derived from the fact that it contains
  17. //* two assembler language instruction. The first instruction clears
  18. //* register 15 (which sets the return code to zero) and the second
  19. //* instruction is a BR 14 which performs an immediate return to the
  20. //* operating system.
  21. //*
  22. //* IEFBR14's only purpose is to help meet the requirements that a
  23. //* job must have at least one EXEC statement. The real purpose is to
  24. //* allow the disposition of the DD statement to occur.
  25. //*
  26. //* For example, the following DISP=(NEW,CATLG) will cause the
  27. //* specified DSN (i.e. PDS) to be allocated.
  28. //* Note: a PDS may also be referred to as a library.
  29. //*
  30. //* The following Partitioned Data Sets are created.
  31. //*
  32. //* SIMOTIME.DEMO.CNTL
  33. //* SIMOTIME.DEMO.COBOL
  34. //* SIMOTIME.DEMO.COBCPY1
  35. //* SIMOTIME.DEMO.ASM
  36. //* SIMOTIME.DEMO.ASMCPY1
  37. //* SIMOTIME.DEMO.ASMMAC1
  38. //* SIMOTIME.DEMO.BMS
  39. //* SIMOTIME.DEMO.MFS
  40. //* SIMOTIME.DEMO.DBD
  41. //* SIMOTIME.DEMO.PSB
  42. //* SIMOTIME.DEMO.OBJECT
  43. //* SIMOTIME.DEMO.LOADLIB1
  44. //* SIMOTIME.DEMO.PROCLIB1
  45. //*
  46. //* The UNIT and VOL are not required for SMS managed data sets.
  47. //* UNIT=SYSDA,VOL=SER=MFILB1,
  48. //*
  49. //CRTPDSX1 EXEC PGM=IEFBR14
  50. //*
  51. //*        The following is for JCL members and PROC library...
  52. //*
  53. //DD01     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.CNTL,
  54. //             STORCLAS=MFI,
  55. //             SPACE=(TRK,(45,15,50)),
  56. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  57. //*
  58. //DD13     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.PROCLIB1,
  59. //             STORCLAS=MFI,
  60. //             SPACE=(TRK,(45,15,50)),
  61. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  62. //*
  63. //*        The following is for COBOL members and Copybooks...
  64. //*
  65. //DD02     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.COBOL,
  66. //             STORCLAS=MFI,
  67. //             SPACE=(TRK,(45,15,50)),
  68. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  69. //DD03     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.COBCPY1,
  70. //             STORCLAS=MFI,
  71. //             SPACE=(TRK,(45,15,50)),
  72. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  73. //*
  74. //*        The following is for Assembler, Copybooks & Macro files...
  75. //*
  76. //DD04     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.ASM,
  77. //             STORCLAS=MFI,
  78. //             SPACE=(TRK,(45,15,50)),
  79. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  80. //DD05     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.ASMCPY1,
  81. //             STORCLAS=MFI,
  82. //             SPACE=(TRK,(45,15,50)),
  83. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  84. //DD06     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.ASMMAC1,
  85. //             STORCLAS=MFI,
  86. //             SPACE=(TRK,(45,15,50)),
  87. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  88. //*
  89. //*        The following is for CICS Basic Mapping Support...
  90. //*
  91. //DD07     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.BMS,
  92. //             STORCLAS=MFI,
  93. //             SPACE=(TRK,(45,15,50)),
  94. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  95. //*
  96. //*        The following is for IMS members...
  97. //*
  98. //DD08     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.MFS,
  99. //             STORCLAS=MFI,
  100. //             SPACE=(TRK,(45,15,50)),
  101. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  102. //DD09     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.DBD,
  103. //             STORCLAS=MFI,
  104. //             SPACE=(TRK,(45,15,50)),
  105. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  106. //DD10     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.PSB,
  107. //             STORCLAS=MFI,
  108. //             SPACE=(TRK,(45,15,50)),
  109. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  110. //*
  111. //*        The following is for OBJECT members...
  112. //*
  113. //DD11     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.OBJECT,
  114. //             STORCLAS=MFI,
  115. //             SPACE=(TRK,(45,15,50)),
  116. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  117. //*
  118. //*        The following is for LOAD members...
  119. //*
  120. //DD12     DD  DISP=(NEW,CATLG),DSN=SIMOTIME.DEMO.LOADLIB1,
  121. //             STORCLAS=MFI,
  122. //             SPACE=(TRK,(45,15,50)),
  123. //             DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PO)
  124. //*


 
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 23:25:36    

Ben quoi t'as les libs, les fichiers en entrées, ceux en sortie, ce qu'il faut en faire si tout va bien ou si çà plante.
Rien que de très profesionnel quoi !
En plus y'a plein de commentaires.


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 23:28:03    

Aussi lisible que de l'assembleur RISC IMHO: Si tu n'ecris que ca a longueur de journée, ca te semble tres lisible, sinon, non.
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 23:28:16    

bon on sort du brainfuck ou du whitespace pour que tout le monde il soit d'accord ?

Reply

Marsh Posté le 10-11-2003 à 23:38:03    

gilou a écrit :

Aussi lisible que de l'assembleur RISC IMHO: Si tu n'ecris que ca a longueur de journée, ca te semble tres lisible, sinon, non.
A+,


Bien sûr je suis d'accord, mais c'est quand même pas mal de pouvoir maitriser ce que le prog va faire des fichiers.
Py c'est quand même un language d'ingé système...
Celà dis, si je ne regrète pas 1 seconde le COBOL, y'a des jours ou le JCL me manque ( et le REXX aussi ). Je sais pas, mais je trouvais çà très très précis comme gestion de fichiers. En plus avec une bonne doc de chez IBM c'est un vrai plaisir. J'ai toujours pensé que tous les éditeurs devairait faire des docs du même niveau que celle d'IBM.


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 23:38:22    

chrisbk a écrit :

bon on sort du brainfuck ou du whitespace pour que tout le monde il soit d'accord ?


Nan :kaola:


---------------
Laissez l'Etat dans les toilettes où vous l'avez trouvé.
Reply

Marsh Posté le 10-11-2003 à 23:40:39    

Si quelqu'un a du code source Multics en PL/I avec des procedures a points d'entrée multiples, ca serait un complement utile a ce topic :D
 
Ah si, j'en ai trouvé, la quintessence du code spaghetti avec des call par nom a des etiquettes, et des go to...
Vous remarquerez que tout est mis dans une procedure unique :D

Code :
  1. /* Created and modified by J. M. Grochow, MIT Information Processing Services */
  3. /* The game of _m_o_o is a fairly simple game played according theto the following algorithm:
  4.    1. The computer selects four random digits (0 to 9).
  5.    2. The player attempts to guess these digits, in order.
  6.    3. The computer gives the player information as to the correctness of his guess.
  7.    a. For every digit guessed in order, a "Bull" is scored.
  8.    b. For every digit guessed out of order, a "Cow" is scored.
  9.    4. The player continues making guesses until four Bulls are scored indicating that
  10.    he has guessed all four digits correctly.
  12.    A short example should help:
  13.    The computer picks 1 2 3 4.
  14.    Player: 5 6 7 8. Score: nothing.
  15.    Player: 1 1 1 1. Score: 1 Bull, 3 Cows.
  16.    Player: 2 3 4 1. Score: 4 Cows.
  17.    Player: 1 2 4 3. Score: 2 Bulls, 2 Cows.
  18.    Player: 1 2 3 4. Score: 4 Bulls. The game is over.
  21.    To play moo, type the following command:
  23.    moo
  25.    To play moo without having your score recorded on the ladder, type:
  27.    moo -d
  29.    To cause the ladder to be recomputed, type:
  31.    moorank
  33.    To see the ladder:
  35.    mooprint
  37.    To see a particular entry in the ladder, e.g. Jones' entry:
  39.    mooprint Jones
  41.     */
  43. /*   DECLARATIONS */
  44. foo: procedure;
  46.           dcl clock_ external entry returns(fixed bin(71));
  47.           dcl person char(22) aligned;                      /* for storing person's name */
  48.           dcl project char(9) aligned;                      /* for benefit of user_info_ */
  49.           dcl account char(32) aligned;                     /* ditto */
  50.           dcl (b,c) fixed bin(35);                          /* bull and cow counters */
  51.           dcl alpha char(26) aligned int static init("ABCDEFGHIJKLMNOPQRSTUVWXYZ" );
  52.           dcl (s1, s2) char(4) aligned;                     /* output strings */
  53.           dcl x(4) fixed bin(35);                           /* player's four digit input */
  54.           dcl count fixed bin(35) int static;               /* number of tries */
  55.           dcl array(4) fixed bin(35);                       /* storage for random digits */
  56.           dcl arrayf(20) float binary(27);                  /* for generating random numbers */
  57.           dcl arrayff(20) based(arrayp) fixed bin(35);      /* overlay */
  58.           dcl printsw fixed bin(35) int static init(0);     /* switch to indicate print program */
  59.           dcl arrayp ptr;                                   /* pointer to generated array */
  60.           dcl timea(0: 1) based(lp1) fixed bin(35);         /* overlay for 71 bit number */
  61.           dcl (i, j, k) fixed bin(35);                      /* do loop indices */
  62.           dcl (bf, cf) float;                               /* comparison temporaries */
  63.           dcl flag fixed bin(35);                           /* flag for ask_ */
  64.           dcl avg float;                                    /* for printing the ladder */
  65.           dcl time fixed bin(71);                           /* for keeping the time */
  66.           dcl arg based(ap) char(al);                       /* argument */
  67.           dcl args char(20) aligned;                        /* argument storage */
  68.           dcl ap ptr, al fixed bin(35);
  70.           dcl (random_$uniform_seq, random_$set_seed, condition_) ext entry;
  71.           dcl (listen_$unclaimed_signal, ios_$abort) external entry;
  72.           dcl (ioa_$nnl, ioa_, cu_$arg_ptr, get_group_id_, com_err_) ext entry;
  73.           dcl (hcs_$initiate, hcs_$terminate_noname, term_$refname) ext entry;
  74.           dcl (ask_$ask_clr, ask_$ask_, ask_$ask_prompt, ask_$ask_int) ext entry;
  75.           dcl moo$mooquit external entry;
  76.           dcl (ask_$ask_cint, user_info_) ext entry;
  78.           dcl 1 l based(ladder) aligned,                    /* ladder declaration */
  79.           2 max fixed bin(35),
  80.           2 num fixed bin(35),
  81.           2 games fixed bin(35),
  82.           2 lowavg float,
  83.           2 lowscore fixed bin(35),
  84.           2 lsperson char(20) aligned,
  85.           2 message char(24) aligned,
  86.           2 e(1000) char(48);
  87.           dcl 1 e based(lp) aligned,                        /* entry declaration */
  88.           2 person char(24) aligned,                        /* name */
  89.           2 space fixed bin(35),
  90.           2 totaltime fixed bin(35),
  91.           2 ngames fixed bin(35),
  92.           2 totscore fixed bin(35),
  93.           2 avg float,
  94.           2 rank fixed bin(35);
  95.           dcl (ladder, lp, lp1) ptr internal static init(null);
  97. /*   */
  99. /* set up a special "quit" handler so that "moo" can take appropriate action */
  101.           printsw = 0;                                      /* for benefit of quit handler */
  102.           call hcs_$terminate_name("term_",i);
  103.           call term_$refname("condition_",i);
  104.           call condition_("quit", moo$mooquit);             /* field all quits */
  105.           count = 0;
  107.           call term_$refname("ask_",i);
  108. /*        cu_ and ioa_ are in bound_command_loop_ and can't be terminated. */
  109. /*        clock_ is in bound_sss_wired_ and can't be terminated. */
  111. /* see if an argument is typed (-d or -x) */
  113.           call cu_$arg_ptr(1, ap, al, flag);
  114.           if flag ^= 0 then do;
  115.                call ioa_("For instructions, type ""print >udd>sa>g>moo.instr""" );
  116.                call ioa_("To see the ladder, type ""moo$mooprint""" );
  117.                call ioa_("To avoid these comments in the future, type ""moo -x""^/" );
  118.           end;
  119.           else if arg = "-d" then do;
  120.                ladder = null;
  121.                call ioa_("Demonstration: no ladder update.^/" );
  122.                go to noladder;
  123.           end;
  125. /* now initiate the ladder and find the person's entry or get his name */
  127.           call hcs_$initiate(">udd>m>pg>p", substr(alpha,6,1)||substr(alpha,15,1)||substr(alpha,15,1), "", 0, 1, ladder
  128. i);
  129. noladder:
  130.           call term_$refname("user_info_", i);
  131.           call user_info_(person, project, account);
  132.           if (index(alpha, substr(person, 1, 1)) = 0) then do;
  133. getname:       call ask_$ask_("Please type your name: ", person);
  134.                if person = "q" then go to returnt;
  135.                if person = "quit" then go to returnt;
  136.                if substr(person, 1, 3) = "Moo" then go to getname;
  137.           end;
  139.           if ladder ^= null then do;
  140.                if ladder->l.lowavg = 0 then ladder->l.lowavg = 1.0e2;
  141.                if ladder->l.lowscore = 0 then ladder->l.lowscore = 100;
  142.                do i = 1 to ladder->l.num;
  143.                     lp = addr(ladder->l.e(i));
  144.                     if person = lp->e.person then go to top;
  145.                end;
  146.                i, ladder->l.num = ladder->l.num + 1;
  147.                lp = addr(ladder->l.e(i));
  148.                lp->e.person = person;
  149.                lp->e.rank = 0;
  150.           end;
  152. /* get the time and get the four random numbers */
  155. top:     
  156.           time = clock_;
  157.           call term_$refname("random_$set_seed", i);
  158.           call term_$refname("random_$uniform_seq", i);
  159.           call random_$set_seed(addr(time)->timea(1));
  160.           call random_$uniform_seq(arrayf, 20);
  161.           arrayp = addr(arrayf);
  162.           do i = 1 to 4;
  163.                flag = 1;
  164.                array(i) = mod(arrayff(21-i), 10);
  165. gen:           do j = 1 to i-1;
  166.                     if array(i) = array(j) then do;
  167.                          if flag = 17 then go to top;
  168.                          array(i) = mod(arrayff(flag), 10);
  169.                          flag = flag + 1;
  170.                          go to gen;
  171.                     end;
  172.                end;
  173.           end;
  175. /* do some initialization */
  177.           count = 0;
  179.           call ask_$ask_clr;
  181. /* do the basic loop for each move - get the numbers, check them, and find bulls and cows */
  183. beginrun: s1, s2 = " ";
  185.           call ask_$ask_prompt("Type number: " );
  187.           do i = 1 to 4;                                    /* now get each of the four numbers guessed and store */
  188.                call ask_$ask_cint(x(i), flag);
  189.                if flag = -1 then do;                        /* an alpha character was typed instead of numeric */
  190.                     if ladder = null then return;           /* demonstration mode: return */
  191.                     if count = 0 then go to returnt;        /* if first guess then return with no penalty */
  192.                     call ioa_("It is antisocial to try to leave a game which is not going well. Please continue." );
  193.                     go to continue;                         /* he is not permitted to quit in the middle */
  194.                end;
  195.              if flag = 0 then if i ^= 5 then call ask_$ask_int("Type ommitted ^d digits: ", x(i), 5-i);
  196.                if x(i) > 9 then do;
  197. continue:           call ioa_("All numbers must be between 0 and 9. Retype this move." );
  198.                     go to beginrun;
  199.                end;
  200.           end;
  202. /* now determine score on this move */
  204.           count = count+1;
  205.           b, c = 1;
  207. /* record bulls and cows */
  209.           do i = 1 to 4;
  210.           if array(i) = x(i) then do; substr(s1, b, 1) = "B"; b = b+1; end;
  211.                do j = 1 to 4;
  212.                if j ^= i then if array(j) = x(i) then do; substr(s2, c, 1) = "C"; c = c+1; end;
  213.                end;
  214.           end;
  216. /* now print his score for this guess */
  218.           call ioa_("^a,^a", s1, s2);
  220. /* if all four bulls are found, then do the appropriate ladder updating */
  222.           if b = 5 then do;
  223.                time = clock_ - time;                        /* compute time for this game */
  224.                if ladder ^= null then do;
  225.                     lp->e.ngames = lp->e.ngames +1;
  226.                     ladder->l.games = ladder->l.games + 1;
  227.                     if mod(ladder->l.games, 1000) = 0 then
  228.                     call ioa_("^RCongratulations: you have just played the ^dth game of moo.^B", ladder->l.games);
  229.                     lp->e.totscore = lp->e.totscore + count;
  230.                     lp->e.avg = (lp->e.totscore + 0.0e0) / lp->e.ngames;
  231.                     lp->e.totaltime = lp->e.totaltime + divide(time, 1000000, 35, 0);
  232.                     if lp->e.avg < ladder->l.lowavg then do;
  233.                          if lp->e.ngames >= 10 then ladder->l.lowavg = lp->e.avg;
  234.                     end;
  235.                     if count < ladder->l.lowscore then do;
  236.                          ladder->l.lowscore = count;
  237.                          ladder->l.lsperson = person;
  238.                     end;
  239.                end;
  240.                call ioa_("^d attempts, ^d seconds.^/", count, (divide(time, 1000000, 35, 0)));
  241.                go to top;
  242.           end;
  244. /* go and initiate another game */
  246.           go to beginrun;
  248. /* terminate ladder before returning */
  250. returnt:  if ladder ^= null then call hcs_$terminate_noname(ladder, flag);
  251.           return;
  253. /*   */
  255. /* entry point to print the ladder or your entry in it */
  257. mooprint: entry;
  259. /* field all quits */
  261.           printsw = 1;
  262.           call condition_("quit", moo$mooquit);             /* field all quits */
  264.           on zerodivide;
  266. /* initiate the ladder and see if there are any arguments */
  268.           call hcs_$initiate(">udd>m>pg>p", substr(alpha,6,1)||substr(alpha,15,1)||substr(alpha,15,1), "", 0, 1, ladder
  269. i);
  270.           if ladder = null then do;
  271.                call com_err_(i, "mooprint", "" );
  272.                go to returnt;
  273.           end;
  275.           call cu_$arg_ptr(1, ap, al, c);
  276.           if c = 0 then do;
  277.                args = arg;
  278.                if args = "nosort" then c = 1;
  279.                else go to sortblock;
  280.           end;
  282. /* print the header */
  284.           call ioa_("^/^a", ladder->l.message);
  286.           call ioa_("Number of people: ^d^-^-Number of games: ^d", ladder->l.num, ladder->l.games);
  287.           call ioa_("Lowest sustained avg.: ^5.2f^-^-Lowest single time score: ^d (by ^a)^/",
  288.           ladder->l.lowavg, ladder->l.lowscore, ladder->l.lsperson);
  289.           call ioa_("Rank   Avg.  Avg.T  Games  Score  Name" );
  291.           go to sortblock;
  293. /*   */
  295. /* entry point to do ranking */
  297. moorank:  entry;
  299. /* field all quits */
  301.           printsw = -1;
  302.           call condition_("quit", moo$mooquit);             /* field all quits */
  304. /* initiate the ladder */
  306.           call hcs_$initiate(">udd>m>pg>p", substr(alpha,6,1)||substr(alpha,15,1)||substr(alpha,15,1), "", 0, 1, ladder
  307. j);
  308.           if ladder = null then do;
  309.                call com_err_(j, "moorank", "" );
  310.                go to returnt;
  311.           end;
  313. /* a special block to do the sorting - allocates an array to help */
  315. sortblock: begin; dcl nums(3000) fixed bin(35);
  317.                do i = 1 to ladder->l.num;
  318.                     nums(i) = i;
  319.                end;
  321. /* check if this is print with no sorting necessary */
  323.                if printsw = 1 then if c = 1 then go to print1;
  325. /* routine to perform interchange sort using the array nums to store array indices */
  328. sortl:         j = 0;
  329.                do i = 1 to ladder->l.num-1;
  330.                     lp = addr(ladder->l.e(nums(i))); lp1 = addr(ladder->l.e(nums(i+1)));
  331.                     if printsw = 1 then do;
  333.                          if lp->e.rank = 0 then bf = 3000;
  334.                          else bf = lp->e.rank;
  335.                          if lp1->e.rank = 0 then cf = 3000;
  336.                          else cf = lp1->e.rank;
  337.                     end;
  338.                     else do;
  339.                          bf = lp->e.avg;
  340.                          cf = lp1->e.avg;
  341.                     end;
  342.                     if bf > cf then do;
  343.                          k = nums(i);
  344.                          nums(i) = nums(i+1);
  345.                          nums(i+1) = k;
  346.                          j = 1;
  347.                     end;
  348.                end;
  349.                if j ^= 0 then go to sortl;
  351. /* if this is the print program, then print out the ladder */
  353. print1:        if printsw = 1 then do;
  354.                     do i = 1 to ladder->l.num;
  355.                          lp = addr(ladder->l.e(nums(i)));
  356.                          if c = 0 then if args ^= lp->e.person then go to prendl;
  357.                          flag = divide(lp->e.totaltime, lp->e.ngames, 35, 0);
  358.                          call ioa_(" ^3d  ^5.2f  ^5d   ^4d  ^5d  ^a",
  359.                          lp->e.rank, lp->e.avg, flag, lp->e.ngames, lp->e.totscore, lp->e.person);
  360.                          if c = 0 then go to returnt;
  361. prendl:             end;
  362.                     call ioa_("" );
  363.                     go to returnt;
  364.                end;
  366. /* if this is the rank program, then put in the new ranking */
  368.                avg = 1.0e2;                                 /* set it high */
  369.                flag = 0;                                    /* to account for those with 0 average */
  370.                do i = 1 to ladder->l.num;
  371.                     lp = addr(ladder->l.e(nums(i)));
  372.                     if (lp->e.avg = 0.0e0) | (lp->e.ngames < 5) then do;
  373.                          lp->e.rank = 0;
  374.                          flag = flag + 1;
  375.                          go to endloop;
  376.                     end;
  377.                     if lp->e.ngames > 10 then if lp->e.avg < avg then avg = lp->e.avg;
  378.                     lp->e.rank = i - flag;
  379.                     do j = i to 1 by -1;
  380.                          lp1 = addr(ladder->l.e(nums(j)));
  381.                          if lp->e.avg = lp1->e.avg then lp->e.rank = lp1->e.rank;
  382.                          if lp->e.avg > lp1->e.avg then go to endloop;
  383.                     end;
  384. endloop:       end;
  386.                ladder->l.lowavg = avg;                      /* adjust the low average */
  387.                go to returnt;
  389.           end;
  391. /*   */
  393. /* entry point to handle console quits so as not to give the user any unfair advantages */
  395. mooquit:  entry;
  397.           call ios_$abort("user_i/o", ""b, time);           /* reset console quit condition */
  398.           call ioa_$nnl("^RMOOQUIT^B" );
  400. /* if quit while in print or rank then simply terminate the ladder */
  402.           if printsw ^= 0 then go to mooqret1;
  404. /* if the "try" count is zero then simply inform the user of the proper way to terminate play */
  406.           if count = 0 then do;
  407.                call ioa_(": Normal exit is by typing ""q"" instead of your first move." );
  408.                go to mooqret;
  409.           end;
  411. /* if the ladder way not initiated then simply unwind the stack */
  413.           if ladder = null then do;
  414. mooqret1:      call ioa_("" );
  415.                go to mooqret;
  416.           end;
  418. /* otherwise, add 10 to his score and tell him that he isn't playing fair */
  420.           else do;
  421.                call ioa_(": Ten points have been added to your total score." );
  422.                lp->e.totscore = lp->e.totscore + 10;
  423.                on zerodivide;
  424.                lp->e.avg = (lp->e.totscore + 0.0e0) / lp->e.ngames;
  425.                call ioa_("Your new average is ^5.2f", lp->e.avg);
  426.           end;
  428. /* terminate the ladder and unwind the stack */
  430. mooqret:  if ladder ^= null then call hcs_$terminate_noname(ladder, flag);
  431.           call listen_$unclaimed_signal;                    /* revert stack */
  433.           return;                                           /* never executed */
  435. end foo;


A+,


Message édité par gilou le 10-11-2003 à 23:43:51

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 10-11-2003 à 23:42:36    

gilou a écrit :


A+,
 
 
 
A+,
 
 


 
je tenais a quoter ce merdage a+sien

Reply

Marsh Posté le 10-11-2003 à 23:45:24    

chrisbk a écrit :


 
je tenais a quoter ce merdage a+sien

[:rofl]


---------------
lecteur mp3 yvele's smilies jeux de fille
Reply

Marsh Posté le 10-11-2003 à 23:45:57    

Qui a ete corrigé durant ton edit.
 
Quand je pense que quand j'ai appris l'info, je lisais le PL/I multics dans le source comme aijourd'hui le C(/++/#)...
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed