ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/BASIC/ASIC20.ZIP/LIFE.ASI

Text File | 1990-02-25 | 5.8 KB | 237 lines

dim a(1600)
dim b(1600)
rem LIFE -- An ASIC Demonstration Program
rem Copyright 1990 by David A. Visti

REM LIFE was developed by John Conway in Scientific American.  It utilizes a
REM simple alogrithm to generate interesting patterns on the screen.
REM The playing field is 20x80 characters in size.  Each character position can
REM be empty, or it can contain a single "cell" of life.  The rules of LIFE
REM are simple.  Any "cell" which has less then 2 neighboring "cells" dies of
REM isolation.  Any "cell" which has more than 3 neighboring "cells" dies of
REM overcrowding.  Any "cell" with 2 or 3 neighbors will continue to live.
REM Finally, any empty character position which has exactly 3 neighbors which
REM contain "cells" will give birth to a new "cell".

REM The following are notes specific to this implementation of LIFE:

REM 1. Any valid ASCII character value 1-255 can be used to represent the
REM    life cells.  The default value is 177 ("▒").  Just change the
REM    line containing "symbol=nnn" to the value you prefer.
REM 2. The colors on the screen (for color graphics equipped systems) are
REM    set in the "initgame" routine.  The first "color n,n" statement
REM    sets the color in the "Cell" area of the screen to yellow foreground
REM    on a blue background.  The second "color n,n" statement sets the color
REM    in the "Text" area of the screen to yellow foreground on a green
REM    background.
REM 3. Two arrays are used to hold "cell" information.  Array "B" is used to
REM    calculate births/deaths.  Array "A" is used to temporarily hold a new
REM    generation of cells, and it is used to copy the cells directly to
REM    the video memory.
REM 4. It is assumed that the edges of the playing area are unsuitable for life
REM    cells, so no cells will thrive in the outside row/col of the playing area

REM program begins here
   gosub initgame:
   gosub music:
   gosub updatedisplaymatrix:
   gosub updatescreen:
loop: gosub computenewgen:
   time=time+1
   gosub updatecalcmatrix:
   gosub updatescreen:
   x$=inkey$
   if x$="" then loop:
   cls
   end

updatescreen: rem this code updates the screen after each gen is calculated
   rem it utilizes direct video RAM writes for maximum speed
   for i=0 to 3199
      varaddr=varptr(a(0))
      varaddr=varaddr+2
      varaddr=varaddr+i
      pokeval=peek(varaddr)
      rem point to video memory segment
      defseg=vidmemseg
      poke i,pokeval
      rem reset data segment register to default
      defseg=-1
      i=i+1
   next i
   locate 24,12
   print  time;
   return

updatedisplaymatrix: rem copy calculation matrix to display matrix
   for i=0 to 19
       for j = 1 to 80
           k=i*80
           k=k+j
           a(k)=b(k)
       next j
   next i
   return

initgame: rem initialize game

   randomize
   symbol=177
   crowddeath=symbol*3
   lonelydeath=symbol*2
   newbirth=symbol*3
   time=0
   cls
   rem initially set video memory segment to monochrome adapter
   vidmemseg=-20480
   vidtype=zmode
   rem check for color graphics adapter
   if vidtype=0 then leavedefaultcolors:
   rem we have a CGA or other color graphics card
   vidmemseg=-18432
   color 14,1
   rem set first 20 lines attribute bytes to BLUE
   for i=1 to 44
      print "                                        ";
   next i
   rem set remaining 5 lines to GREEN
   locate 21,0
   color 14,2
   for i=1 to 10
      print "                                        ";
   next i
leavedefaultcolors:
   locate 20,25
   print "    <  L  I  F  E  >";
   locate 21,10
   print "        A Demonstration Program written in ASIC";
   locate 22,15
   print "     <Copyright 1990 by David A. Visti>";
   locate 23,15
   print "           <All Rights Reserved>";
   locate 24,1
   print "Generation";
   locate 24,56
   print "<Press any key to EXIT>";
   for i=0 to 19
       for j=1 to 80
           k=i*80
           k=k+j
           k1=rnd(0)
           if k1>28000 then makefullcell:
makeempytcell:
           b(k)=0
           goto continit:
makefullcell:
           b(k)=symbol
continit:
       next j
   next i
   return

computenewgen:
   for i=0 to 19
       for j=1 to 80
           k=i*80
           k=k+j
           if i=0 then clearcell:
           if i=19 then clearcell:
           if j=1 then clearcell:
           if j=80 then clearcell:
           n=0
           k2=k-81
           n=n+b(k2)
           k2=k-80
           n=n+b(k2)
           k2=k-79
           n=n+b(k2)
           k2=k-1
           n=n+b(k2)
           k2=k+1
           n=n+b(k2)
           k2=k+79
           n=n+b(k2)
           k2=k+80
           n=n+b(k2)
           k2=k+81
           n=n+b(k2)
           if n> crowddeath then clearcell:
           if n<lonelydeath then clearcell:
           if n<newbirth then survivecell:
           a(k)=symbol
           goto nextcell:
survivecell: a(k)=b(k)
           goto nextcell:
clearcell: a(k)=0
nextcell:
       next j
   next i
return

updatecalcmatrix:
   for i=0 to 19
       for j = 1 to 80
           k=i*80
           k=k+j
           b(k)=a(k)
       next j
   next i
   return

music:  rem play a short little tune

   tune$="<<<<GD<GD<<<<<GD<500"


rem laser sound
k=150
n=0
for m=1 to 5
for i=n to k
    sound i,1
next i
j=k
for i=n to k
    sound j,1
    j=j-1
next i
next m

rem siren
k=450
for i=n to k
    sound i,1
next i
j=k
for i=n to k
   sound j,1
   j=j-1
next i
for i=1 to 10000
next i

rem fanfare
base=10
n=len(tune$)
for i=1 to n
   note$=mid$(tune$,i,1)
   note=asc(note$)
   note=note*base
   i=i+1
   length$=mid$(tune$,i,1)
   length=asc(length$)
   length=length*base
   sound note,length
   gosub d1:
next i
return

d1:for killtime=1 to 750
next killtime
return