DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Notes: Mikados TextFile, Mikados_K
    Names: »LIFE1«

└─⟦0ca3cf8fa⟧ Bits:30004600 DEMO1 - COMAL demoprogram
    └─⟦this⟧ »LIFE1« 

Text

0100 REM 
0110 REM FORMÅL......:  DEMOSTRATIONS PROGRAM.
0120 REM 
0130 REM PROGRAM NAVN:  GAME OF LIVE (PÅ DISK: LIFE)
0140 REM PROGRAMMØR..:  (UKENDT) , DDE 17/05/1979
0150 REM SPROG.......:  DDE COMAL FORTOLKER
0160 REM VERSION NO..:  E5A  (LIFE1)
0170 REM 
0180 REM VARIABELLISTE, SE I LIFE.
0190 REM 
0200 REM DIMENSIONERING AF VARIABLERNE.
0210 REM 
0220 ON1=9;MAXROW=24;MAXCOL=41;MAXROW1=MAXROW+1;MAXCOL1=MAXCOL+1;ROW,COL=0
0230 DIM ACTBOARD(MAXROW1,MAXCOL1),LINE$(MAXCOL)
0240 DIM SAVBOARD(MAXROW1,MAXCOL1),SPACE$(MAXCOL)
0250 I,J,GENERATION,ALIVECOUNT=0;SPACE$=" "
0260 FOR ROW=1 TO MAXROW1
0270 FOR COL=1 TO MAXCOL1
0280 ACTBOARD(ROW,COL),SAVBOARD(ROW,COL)=0
0290 NEXT COL
0300 NEXT ROW
0310 FOR I=2 TO MAXCOL
0320 SPACE$=SPACE$+" "
0330 NEXT I
0340 REM 
0350 REM HOVEDPROGRAM.
0360 REM 
0370 EXEC READGENERATION
0380 CLEAR 
0390 CURSOR 20,1
0400 PRINT "GENERATION NO.   0"
0410 EXEC PRINTGENERATION
0420 REPEAT 
0430 EXEC NEXTGENERATION
0440 CURSOR 1,1
0450 UNTIL ALIVECOUNT=0
0460 CURSOR 41,1
0470 PRINT "DEAD";CHR(27);"T"
0480 CURSOR 15,24
0490 PRINT "PROGRAM FÆRDIGT!";CHR(11)
0500 GO TO 0500
0510 END ;HOVEDPROGRAM.
0520 REM 
0530 PROC CLEARBOARD(B)
0540 FOR ROW=1 TO MAXROW1
0550 FOR COL=1 TO MAXCOL1
0560 B(ROW,COL)=0
0570 NEXT COL
0580 NEXT ROW
0590 ENDPROC ;CLEARBOARD
0600 REM 
0610 PROC SETCELL(B,ROWW,COLL)
0620 B(ROWW-1,COLL-1)=B(ROWW-1,COLL-1)+1
0630 B(ROWW-1,COLL)=B(ROWW-1,COLL)+1
0640 B(ROWW-1,COLL+1)=B(ROWW-1,COLL+1)+1
0650 B(ROWW,COLL-1)=B(ROWW,COLL-1)+1
0660 B(ROWW,COLL)=B(ROWW,COLL)+ON1
0670 B(ROWW,COLL+1)=B(ROWW,COLL+1)+1
0680 B(ROWW+1,COLL-1)=B(ROWW+1,COLL-1)+1
0690 B(ROWW+1,COLL)=B(ROWW+1,COLL)+1
0700 B(ROWW+1,COLL+1)=B(ROWW+1,COLL+1)+1
0710 ALIVECOUNT=ALIVECOUNT+1
0720 ENDPROC ;SETCELL
0730 REM 
0740 PROC REMOVECELL(B,ROWW,COLL)
0750 B(ROWW-1,COLL-1)=B(ROWW-1,COLL-1)-1
0760 B(ROWW-1,COLL)=B(ROWW-1,COLL)-1
0770 B(ROWW-1,COLL+1)=B(ROWW-1,COLL+1)-1
0780 B(ROWW,COLL-1)=B(ROWW,COLL-1)-1
0790 B(ROWW,COLL)=B(ROWW,COLL)-ON1
0800 B(ROWW,COLL+1)=B(ROWW,COLL+1)-1
0810 B(ROWW+1,COLL-1)=B(ROWW+1,COLL-1)-1
0820 B(ROWW+1,COLL)=B(ROWW+1,COLL)-1
0830 B(ROWW+1,COLL+1)=B(ROWW+1,COLL+1)-1
0840 ALIVECOUNT=ALIVECOUNT-1
0850 ENDPROC ;REMOVECELL
0860 REM 
0870 PROC READGENERATION
0880 ROW,ROWMIN,ROWMAX,ROW0=MAXROW1
0890 COL,COLMIN,COLMAX,COL0=MAXCOL1
0900 GENERATION=0
0910 ALIVECOUNT=0
0920 EXEC CLEARBOARD(SAVBOARD)
0930 ROWMIN=MAXROW;ROWMAX=0
0940 COLMIN=MAXCOL;COLMAX=0
0950 ROW=1
0960 PRINT "PLEASE ENTER COLONY"
0970 FOR I=1 TO MAXCOL-1
0980 LINE$(I:1)=CHR(I+48-INT(I/10)*10)
0990 NEXT I
1000 PRINT "  ";LINE$
1010 WHILE ROW<MAXROW DO 
1020 LINE$=CHR(INT(ROW/10)+48)+CHR((ROW-INT(ROW/10)*10)+48)
1030 PRINT LINE$;
1040 LINE$=SPACE$
1050 INPUT LINE$
1060 IF LINE$=" " THEN EXIT ;WHILE
1070 J=MAXCOL1-LEN(LINE$)
1080 FOR I=1 TO J
1090 LINE$=LINE$+" "
1100 NEXT I
1110 ROW=ROW+1
1120 COL=1
1130 WHILE COL<MAXCOL DO 
1140 COL=COL+1
1150 IF LINE$(COL-1)<>" " THEN 
1160 EXEC SETCELL(SAVBOARD,ROW,COL)
1170 IF ROW<ROWMIN THEN ROWMIN=ROW
1180 IF COL<COLMIN THEN COLMIN=COL
1190 IF ROW>ROWMAX THEN ROWMAX=ROW
1200 IF COL>COLMAX THEN COLMAX=COL
1210 ENDIF 
1220 ENDWHILE 
1230 ENDWHILE 
1240 REM 
1250 REM PUT THE FIGURE IN THE MIDDLE
1260 REM 
1270 ROW0=((MAXROW1-ROWMIN-ROWMAX) DIV 2)+1
1280 COL0=((MAXCOL1-COLMIN-COLMAX) DIV 2)+1
1290 FOR ROW=ROWMIN-1 TO ROWMAX+1
1300 FOR COL=COLMIN-1 TO COLMAX+1
1310 ACTBOARD(ROW+ROW0,COL+COL0)=SAVBOARD(ROW,COL)
1320 NEXT COL
1330 NEXT ROW
1340 EXEC CLEARBOARD(SAVBOARD)
1350 ENDPROC ;READGENERATION
1360 REM 
1370 PROC CELLON(Y,X)
1380 REM 
1390 REM WRITE TWO STARS IN POSITION (X-1,Y) AS A LIVING CELL.
1400 REM 
1410 CURSOR X-1,Y
1420 PRINT "<S>**"
1430 ENDPROC ;CELLON
1440 REM 
1450 PROC CELLOFF(Y,X)
1460 REM 
1470 REM WRITE TWO SPACES IN POSITION (X-1,Y) AS A DEAD CELL
1480 REM 
1490 CURSOR X-1,Y
1500 PRINT "<S>  "
1510 ENDPROC ;CELLOFF
1520 REM 
1530 PROC NEXTGENERATION
1540 ROW=MAXROW1
1550 COL=MAXCOL1
1560 GENERATION=GENERATION+1
1570 FOR I=2 TO MAXROW
1580 FOR J=2 TO MAXCOL
1590 SAVBOARD(I,J)=ACTBOARD(I,J)
1600 NEXT J
1610 NEXT I
1620 CURSOR 33,1
1630 PRINT USING "<S> ####":GENERATION
1640 FOR ROW=2 TO MAXROW
1650 FOR COL=2 TO MAXCOL
1660 CASE SAVBOARD(ROW,COL) OF 
1670 WHEN 3
1680 REM 
1690 REM A NEW CELL IS BORN!
1700 REM 
1710 EXEC SETCELL(ACTBOARD,ROW,COL)
1720 EXEC CELLON(ROW,(COL-1)*2)
1730 WHEN 9,10,13,14,15,16,17
1740 REM 
1750 REM A CELL DIES. IF 9 OR 10 FOR LONELINESS
1760 REM _            IF 13 TO 17 BECAUSE TOO CROWDED
1770 REM 
1780 EXEC REMOVECELL(ACTBOARD,ROW,COL)
1790 EXEC CELLOFF(ROW,(COL-1)*2)
1800 ENDCASE 
1810 NEXT COL
1820 NEXT ROW
1830 ENDPROC ;NEXTGENERATION
1840 REM 
1850 PROC PRINTGENERATION
1860 FOR ROW=2 TO MAXROW
1870 FOR COL=2 TO MAXCOL
1880 IF ACTBOARD(ROW,COL)>8 THEN EXEC CELLON(ROW,(COL-1)*2)
1890 NEXT COL
1900 NEXT ROW
1910 ENDPROC ;PRINTGENERATION