CLEAR ,90000&: DEFINT a-q,s-y
DIM cs(7,999),sw(1,49,149),b$(4),item(1,15),a(2)
DIM ssmRescue(49,149),scsRescue(999)
DATA 1,1,0,0,0,0,0,0,0,1,1,0,0,1,1,1
FOR n=0 TO 15
  READ a
  item(0,n)=a
  item(1,n)=ABS(a-1)
NEXT n
nnbI=1:nnbII=1:df$="DATA":random=1.2:neighbour=8:liveat=3:stayat=2

SCREEN 1,640,250,2,2
  WINDOW 9,"mem ",(556,92)-(631,236),20,1
  GOSUB ColorReset
  FOR n=0 TO 120 STEP 24
    LINE (1,n+1)-(52,n+22),1,b
    LOCATE INT(n/8)+2,9:PRINT CHR$(65+n/24)
  NEXT n
  WINDOW 8,"co-ordinates         ",(0,212)-(132,236),16,1
  PRINT "mode :"
  PRINT "   x :"
  PRINT "   y :";
  WINDOW 10,"message                                       ",(144,212)-(544,236),16,1
  COLOR 2:PRINT "welcome to GAME OF LIFE";
  MENU 1,0,1,"about"
  MENU 1,1,1,"                                "
  MENU 1,2,1,"  Game Of Life Research Program "
  MENU 1,3,1,"                                "
  MENU 1,4,1,"           Release 2.2          "
  MENU 1,5,1,"                                "
  MENU 1,6,1,"   March 1990 by Rainer Umbach  "
  MENU 1,7,1,"                                "
  MENU 2,0,1,"go ahead"
  MENU 2,1,1,"ask rules                 "
  MENU 2,2,1,"normal simulation         "
  MENU 2,3,1,"single step simulation    "
  MENU 2,5,1,"suicide                   "
  MENU 3,0,1,"edit"
  MENU 3,1,1,"change rules        "
  MENU 3,2,1,"recall last sim     "
  MENU 3,3,1,"erase buffer        "
  MENU 3,4,1,"erase part of window"
  MENU 3,5,1,"erase whole window  "
  MENU 3,6,1,"inverse buffer      "
  MENU 3,7,1,"grid off            "
  MENU 4,0,1,"copy"
  MENU 4,1,1,"part of window to memory"
  MENU 4,2,1,"memory into window      "
  MENU 4,4,1,"buffer into window      "
  MENU 4,5,1,"buffer to memory        "
  MENU 4,6,1,"memory to buffer        "
  MENU 4,7,1,"memory to memory        "
  MENU 5,0,1,"mem`s"
  MENU 5,1,1,"a: noname mem                              "
  MENU 5,2,1,"b: noname mem                              "
  MENU 5,3,1,"c: noname mem                              "
  MENU 5,4,1,"d: noname mem                              "
  MENU 5,5,1,"e: noname mem                              "
  MENU 5,6,1,"f: noname mem                              "
  MENU 5,7,1,"cancel choice                              "
  MENU 6,0,1,"logical operations"
  MENU 6,1,1,"buffer AND memory"
  MENU 6,2,1,"buffer OR  memory"
  MENU 6,3,1,"buffer XOR memory"
  MENU 7,0,1,"disk"
  MENU 7,1,1,"save memory"
  MENU 7,2,1,"load memory"
  MENU 7,3,1,"save window"
  MENU 7,4,1,"load window"
  MENU 7,5,1,"directory  "
  MENU ON
GOTO scs

ssm:

  ON ERROR GOTO ssmFehler
  WINDOW CLOSE 5
  h$=SPACE$(50)
  WINDOW 3,"structure simulation mode"+h$,(0,1)-(600,201),16,1
  wi=3:GOSUB just:GOSUB setMENU
  MENU 2,4,1,"structure construction set"
  MENU 4,3,1,"casual into window      "
  CALL ssmGitter
  IF nnbII=0 THEN
    wi=wi-3:a=0
    FOR m=1 TO 200 STEP 4
      b=0
      FOR n=1 TO 600 STEP 4
        IF sw(wi,a,b) THEN LINE (n,m)-(n+2,m+2),3,bf
        b=b+1
      NEXT n
      a=a+1
    NEXT m
    wi=wi+3
  END IF
  mess=6:GOTO messageFresh

  ssmRefresh:
    WINDOW OUTPUT 8:LOCATE 1,8:COLOR 2:PRINT "ssm mouse"
    WINDOW OUTPUT 3
    CALL ssmMouse(x,y,c)
    men=MENU(0)
    meno=MENU(1)
    IF men=2 THEN
      ON meno GOTO ssmask,ssmStartenI,ssmStartenII,scs,suicide
    ELSEIF men=3 THEN
      IF meno=1 THEN ssmRules
      IF meno=2 THEN ssmRedraw
      IF meno=4 THEN ssmLoeschen
      IF meno=5 THEN ssmErase
    ELSEIF men=4 THEN
      IF meno=1 THEN ssmLesen
      IF meno=2 THEN ssmSetzen
      IF meno=3 THEN ssmCasual
      IF meno=4 THEN ssmBufferCopy
      IF meno=7 THEN Kopieren
    ELSEIF men=7 THEN
      ON meno GOTO Sichern,Laden,ssmSichern,ssmLaden,Directory
    END IF
    GOTO ssmRefresh

  ssmFehler:
    CALL Fehleranzeige
    WINDOW OUTPUT wi
    RESUME ssmRefresh

  ssmask:
    GOSUB askRules
    GOTO ssmRefresh
    
  ssmRules:
    CALL rules(random,neighbour,liveat,stayat)
    WINDOW OUTPUT wi
    mess=6:GOTO messageFresh
    
  ssmLoeschen:
    WINDOW OUTPUT 10:COLOR 2:PRINT
      PRINT "enter co-ordinates of area to erase, it`s a frame" 
      PRINT "use mouse pointer and left mouse botton" 
      PRINT "first top/left, then bottom/right";
    WINDOW OUTPUT wi
    GOSUB catchtheMouse
    x1=x*4:y1=y*4:x3=x1:y3=y1
  ssmLoeschenMarke:
    CALL ssmMouse(x,y,c)
    a=x*4:b=y*4
    IF a>=x1 THEN x2=a:ELSE x2=x1
    IF b>=y1 THEN y2=b:ELSE y2=y1 
    IF x2<>x3 OR y2<>y3 THEN
      LINE (x1,y1)-(x3+4,y3+4),1,b
      LINE (x1,y1)-(x2+4,y2+4),2,b:x3=x2:y3=y2
    END IF
    IF c<>0 THEN ssmLoeschenMarke
    LINE (x1,y1)-(x2+4,y2+4),0,bf
    LINE (0,0)-(600,200),1,b
    CALL ssmGitter
    x1=x1/4:x2=x2/4:y1=y1/4:y2=y2/4
    FOR n=y1 TO y2
      FOR m=x1 TO x2
        sw(0,n,m)=0
        sw(1,n,m)=0
      NEXT m
    NEXT n
    mess=6:GOTO messageFresh

  ssmErase:
    GOSUB just
    LINE (0,0)-(600,200),0,bf
    CALL ssmGitter
    FOR n=0 TO 49
      FOR m=0 TO 149
        sw(0,n,m)=0
        sw(1,n,m)=0
      NEXT m
    NEXT n
    nnbII=1:mess=6:GOTO messageFresh

  ssmSichern:
    y2=127:GOSUB filename:IF f$="/" THEN ssmRefresh
    GOSUB just
    wi=wi-3
    OPEN f$ FOR OUTPUT AS #1
    FOR n=0 TO 49
      FOR m=0 TO 149
        WRITE#1,sw(wi,n,m)
      NEXT m
    NEXT n
    CLOSE 1
    KILL f$+".info"
    wi=wi+3
    mess=2:GOTO messageFresh

  ssmLaden:
    y2=128:GOSUB filename:IF f$="/" THEN ssmRefresh
    GOSUB just
    OPEN f$ FOR INPUT AS #1
    wi=wi-3:a=0
    FOR m=1 TO 200 STEP 4
      b=0
      FOR n=1 TO 600 STEP 4
        INPUT#1,c
        IF c<>sw(wi,a,b) THEN LINE (n,m)-(n+2,m+2),c*3,bf
        sw(0,a,b)=c:sw(1,a,b)=c
        b=b+1
      NEXT n
      a=a+1
    NEXT m
    CLOSE
    wi=wi+3
    nnbII=0:mess=2:GOTO messageFresh
  
  ssmRedraw:
    GOSUB just:a=0
    FOR m=1 TO 200 STEP 4
      b=0
      FOR n=1 TO 600 STEP 4
        sw(0,a,b)=ssmRescue(a,b):sw(1,a,b)=sw(0,a,b)
        LINE (n,m)-(n+2,m+2),sw(0,a,b)*3,bf
        b=b+1
      NEXT n
      a=a+1
    NEXT m
    nnbII=0:mess=1:GOTO messageFresh
    
  ssmStartenII:
    smod=2
      
  ssmStartenI:
    FOR n=0 TO 49
      FOR m=0 TO 149
        ssmRescue(n,m)=sw(0,n,m)
        sw(1,n,m)=sw(0,n,m)
      NEXT m
    NEXT n
    ret=0:IF nnbII=1 THEN ssmSimulationsende
    WINDOW OUTPUT 10:COLOR 2
    IF smod=2 THEN PRINT:PRINT  "any key continues after signal black-orange-black";
    PRINT:PRINT  "stop simulation with space";
    WINDOW wi
    GOSUB just
    GOSUB ssmSimulationsinit
    IF xr<xl THEN ssmSimulationsende
    FOR n=0 TO 3
      PALETTE n,.1,.1,1
    NEXT
    PALETTE 3,1,.55,0
    us=0
  ssmStartenMarke:
    w=wi-3
    IF wi=3 THEN wi=4:ELSE wi=3
    yor=0:yur=0:xlr=0:xrr=0:yov=0:yuv=0:xlv=0:xrv=0:settest=0:a$=""
    wi=wi-3
    FOR n=yo TO yu
      o=n-1:IF o=-1 THEN o=49
      u=n+1:IF u=50 THEN u=0
      FOR m=xl TO xr
        l=m-1:IF l=-1 THEN l=149
        r=m+1:IF r=150 THEN r=0
        a=sw(w,o,m)+sw(w,u,m)+sw(w,n,l)+sw(w,n,r)
        IF neighbour=8 THEN a=a+sw(w,o,l)+sw(w,o,r)+sw(w,u,l)+sw(w,u,r)
        IF a<>stayat THEN 
          IF a=liveat THEN c=1:ELSE c=0
          IF sw(w,n,m)<>c THEN
            aa=m*4+1:bb=n*4+1:settest=1
            LINE (aa,bb)-(aa+2,bb+2),c*3,bf
          END IF   
        ELSE 
          c=sw(w,n,m)
        END IF
        sw(wi,n,m)=c
        IF a$="" THEN a$=INKEY$
      NEXT m
      IF a$=" " THEN ret=1
    NEXT n
    IF (ret OR settest=0) AND wi=0 THEN GOTO ssmSimulationsende
    FOR xx=xl TO xr
      IF sw(wi,yo,xx) THEN yor=1
      IF sw(wi,yu,xx) THEN yur=1
    NEXT xx
    FOR yy=yo TO yu
      IF sw(wi,yy,xl) THEN xlr=1
      IF sw(wi,yy,xr) THEN xrr=1
    NEXT yy
    yo=yo-yor:yu=yu+yur:xl=xl-xlr:xr=xr+xrr
    FOR xx=xl+1 TO xr-1
      IF sw(wi,yo+1,xx) THEN yov=1
      IF sw(wi,yu-1,xx) THEN yuv=1
    NEXT xx
    FOR yy=yo+1 TO yu-1
      IF sw(wi,yy,xl+1) THEN xlv=1
      IF sw(wi,yy,xr-1) THEN xrv=1
    NEXT yy
    GOSUB SimulationstestI
    IF us THEN
      IF yo=2 THEN
        FOR y=yo TO yu:FOR x=xl TO xr:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        yo=y-2:us=0
      END IF
      IF yu=47 THEN
        FOR y=yu TO yo STEP -1:FOR x=xl TO xr:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        yu=y+2:us=0
      END IF
      IF xl=2 THEN
        FOR x=xl TO xr:FOR y=yo TO yu:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        xl=x-2:us=0
      END IF
      IF xr=147 THEN
        FOR x=xr TO xl STEP -1:FOR y=yo TO yu:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        xr=x+2:us=0
      END IF
    END IF
    wi=wi+3
    IF smod=2 AND ret=0 THEN GOSUB stepbystep
    GOTO ssmStartenMarke

    ssmSimulationsende:
      GOSUB ColorReset 
      wi=3:smod=0:mess=4:GOTO messageFresh
        
    ssmSimulationsinit:
      wi=wi-3
      FOR x=0 TO 149:FOR y=0 TO 49:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        xl=x-1
      FOR y=0 TO 49:FOR x=0 TO 149:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        yo=y-1
      FOR x=149 TO 0 STEP -1:FOR y=0 TO 49:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        xr=x+1
      FOR y=49 TO 0 STEP -1:FOR x=0 TO 149:IF sw(wi,y,x)=0 THEN NEXT:NEXT
        yu=y+1
      GOSUB SimulationstestII
      wi=wi+3
      RETURN
                 
  ssmLesen:
    GOSUB SchreibLeseHilfeI
    c=(meno-1)*24+2:wi=wi-3
    WINDOW 9
    FOR n=y TO y+19
    a=n-y
      FOR m=x TO x+49
      b=m-x:d=a*50+b
        IF cs(meno,d)<>sw(wi,n,m) THEN
          cs(meno,d)=sw(wi,n,m)
          PSET (2+b,c+a),cs(meno,d)*2
        END IF
      NEXT m
    NEXT n
    GOSUB SchreibLeseHilfeII

  ssmBufferCopy:
    casual=1
    GOSUB SchreibLeseHilfeI
    casual=0:meno=0
    GOTO ssmSetzenMarke
    
  ssmCasual:
    RANDOMIZE TIMER
    casual=1
    GOSUB SchreibLeseHilfeI
    GOTO ssmSetzenMarke
     
  ssmSetzen:
    casual=0
    GOSUB SchreibLeseHilfeI
  ssmSetzenMarke:    
    GOSUB just
    wi=wi-3
    FOR n=y TO y+19
      d=n-y
      IF n>49 THEN a=n-50:ELSE a=n
      FOR m=x TO x+49
        e=m-x:f=d*50+e
        IF m>149 THEN b=m-150:ELSE b=m
        IF casual THEN
          setit=INT(RND(1)*random)
          IF setit THEN
            sw(0,a,b)=setit
            sw(1,a,b)=setit
            aa=a*4+1:bb=b*4+1
            LINE (bb,aa)-(bb+2,aa+2),3,bf
          END IF
        ELSE
          IF cs(meno,f) THEN
            sw(0,a,b)=cs(meno,f)
            sw(1,a,b)=cs(meno,f)
            aa=a*4+1:bb=b*4+1
            LINE (bb,aa)-(bb+2,aa+2),3,bf
          END IF
        END IF
      NEXT m
    NEXT n
    nnbII=0:casual=0:GOSUB SchreibLeseHilfeII

  SchreibLeseHilfeI:
    IF casual=0 THEN
      WINDOW 9
      GOSUB getMENU:IF meno=7 THEN mess=1:GOTO messageFresh
    END IF
    WINDOW OUTPUT 10:PRINT :PRINT "choose area";
    WINDOW OUTPUT 8:LOCATE 1,8:COLOR 2:PRINT "ssm frame"
    WINDOW wi
    WHILE (MOUSE(0)<>0):WEND
    c=0:x2=0:y2=0
    WHILE (c=0)
      CALL ssmMouseII(x,y,c)
      x1=x*4:y1=y*4
      LINE (x1,y1)-(x1+200,y1+80),2,b
      IF x1<>x2 OR y1<>y2 THEN LINE (x2,y2)-(x2+200,y2+80),1,b
      x2=x1:y2=y1
    WEND
    RETURN

  SchreibLeseHilfeII:
    wi=wi+3
    WINDOW wi      
    LINE (x2,y2)-(x2+200,y2+80),1,b
    LINE (0,0)-(600,200),1,b
    mess=1:GOTO messageFresh
     
scs:

  ON ERROR GOTO Fehler
  WINDOW CLOSE 3:WINDOW CLOSE 4
  WINDOW 5,"structure construction set                         ",(0,15)-(401,176),16,1
  wi=5:GOSUB just:GOSUB setMENU
  MENU 2,4,1,"structure simulation mode "
  MENU 4,3,1,"casual to buffer        "
  c=0:colGitter=0:CALL Gitter(colGitter)
  IF nnbI=0 THEN
    FOR m=1 TO 160 STEP 8
      FOR n=1 TO 400 STEP 8
        IF cs(0,c) THEN LINE (n,m)-(n+6,m+6),3,bf
        c=c+1
      NEXT n
    NEXT m
  END IF
  mess=5:GOTO messageFresh

  Sefresh:
    WINDOW OUTPUT 8:LOCATE 1,8:COLOR 2:PRINT "scs mouse"
    WINDOW OUTPUT 5
    c=0
  checkMouse:
    IF c=0 THEN MouseMenue
    CALL LocateMouse(x,y)
    IF x>49 OR y>19 THEN MouseMenue
    c=y*50+x
    IF cs(0,c)=0 THEN 
      cs(0,c)=1:cs(7,c)=1:col=3
    ELSE 
      cs(0,c)=0:cs(7,c)=0:col=0
    END IF
    a=x*8+1:b=y*8+1
    LINE (a,b)-(a+6,b+6),col,bf:nnbI=0
    a=x:b=y              
  Halt:
    c=MOUSE(0)
    CALL LocateMouse(x,y)
    IF a=x AND b=y AND c<>0 THEN Halt
  MouseMenue:
    CALL LocateMouse(x,y)
    IF x>49 THEN x=49
    IF y>19 THEN y=19
    CALL showMouse(x,y,wi)
    men=MENU(0)
    meno=MENU(1)
    IF men=2 THEN
      ON meno GOTO scsask,SimModeI,SimModeII,ssm,suicide
    ELSEIF men=3 THEN
      IF meno=1 THEN scsRules
      IF meno=2 THEN scsRedraw
      IF meno=3 THEN Loeschen
      IF meno=6 THEN Invertieren
      IF meno=7 THEN Gitter
    ELSEIF men=4 THEN
      IF meno=3 THEN scsCasual
      IF meno=5 THEN Schreiben
      IF meno=6 THEN Lesen
      IF meno=7 THEN Kopieren
    ELSEIF men=6 THEN
      ON meno GOTO PuANDSp,PuORSp,PuXORSp
    ELSEIF men=7 THEN
      IF meno=1 THEN Sichern
      IF meno=2 THEN Laden
      IF meno=5 THEN Directory
    END IF
    c=MOUSE(0)
    GOTO checkMouse
    
  Fehler:
    WINDOW CLOSE 11
    CALL Fehleranzeige
    WINDOW OUTPUT wi
    RESUME Sefresh

  scsask:
    GOSUB askRules
    GOTO Sefresh

  scsRules:
    CALL rules(random,neighbour,liveat,stayat)
    WINDOW OUTPUT wi
    mess=5:GOTO messageFresh

  suicide:
    WINDOW OUTPUT 10:COLOR 2:PRINT
    PRINT "it`s against law, at least in Germany"
    PRINT "but even computers are open to corruption ..."
    PRINT "I`m not begging for money, I want bits !";
    b$(1)="b":b$(2)="i":b$(3)="t":b$(4)="s"
    FOR n=1 TO 4
      GOSUB continue
      IF a$<>b$(n) THEN
        PRINT :PRINT "I see, you`re honest":PRINT "ok";
        mess=0:GOTO messageFresh
      END IF
    NEXT n
    MENU RESET
    WINDOW OUTPUT wi:COLOR 0,3:CLS:WINDOW CLOSE wi
    WINDOW OUTPUT  9:COLOR 0,3:CLS:WINDOW CLOSE 9
    WINDOW OUTPUT  8:COLOR 0,3:CLS:WINDOW CLOSE 8
    WINDOW 10,,(120,80)-(520,204),16,1:WINDOW OUTPUT 10:CLS
    COLOR 3,2
    LOCATE 3,10:PRINT "                                "
    LOCATE 4,10:PRINT "  Game Of Life Research Program "
    LOCATE 5,10:PRINT "                                "
    LOCATE 6,10:PRINT "           Release 2.2          "
    LOCATE 7,10:PRINT "                                "
    LOCATE 8,10:PRINT "   March 1990 by Rainer Umbach  "
    LOCATE 9,10:PRINT "                                "
    COLOR 3,0:LOCATE 12,1
    PRINT "      stay alive and keep your Amiga running     "
    COLOR 1,0:PRINT 
    PRINT "        `any key` continues - who`s that ?"
    GOSUB continue
    COLOR 0,3:CLS:WINDOW CLOSE 10
    SCREEN CLOSE 1
    SYSTEM

  scsCasual:
    RANDOMIZE TIMER
    casual=1
    GOSUB just
    GOTO LesenMarke

  Lesen:
    GOSUB getMENU:c=0:IF meno=7 THEN copyMarke
    casual=0
  LesenMarke:
    FOR m=1 TO 160 STEP 8
      FOR n=1 TO 400 STEP 8
        IF casual THEN
          setit=INT(RND(1)*random)
          IF setit THEN
            LINE (n,m)-(n+6,m+6),setit*3,bf
            cs(0,c)=setit:cs(7,c)=setit
          END IF
        ELSE
          IF cs(0,c)<>cs(meno,c) THEN
            LINE (n,m)-(n+6,m+6),cs(meno,c)*3,bf
            cs(0,c)=cs(meno,c):cs(7,c)=cs(meno,c)
          END IF
        END IF
      c=c+1
      NEXT n
    NEXT m
    nnbI=0:GOTO copyMarke

  Kopieren:
    WINDOW 9
    FOR n=1 TO 2
      GOSUB getMENU:a(n)=meno:IF meno=7 THEN copyMarke
    NEXT n:o=a(1)
    GOTO SchreibenMarke

  Schreiben:
    GOSUB getMENU:o=0:IF meno=7 THEN copyMarke
  SchreibenMarke:
    WINDOW OUTPUT 9
    c=0:y=(meno-1)*24+2
    FOR m=0 TO 19
      FOR n=0 TO 49
        IF cs(o,c)<>cs(meno,c) THEN
          PSET (2+n,y+m),cs(o,c)*2
          cs(meno,c)=cs(o,c)
        END IF
        c=c+1
      NEXT n
    NEXT m
    GOSUB resetName

  copyMarke:
    WINDOW wi
    mess=1:GOTO messageFresh

  Sichern:
    WINDOW 9
    GOSUB getMENU:IF meno=7 THEN diskMarke
    WINDOW 9
    y2=127:GOSUB filename:IF f$="/" THEN diskMarke
    OPEN f$ FOR OUTPUT AS #1
    FOR n=0 TO 999
      WRITE#1,cs(meno,n)
    NEXT n
    CLOSE 1
    KILL f$+".info"
    GOSUB setName
    GOTO diskMarke

  Laden:
    WINDOW 9
    GOSUB getMENU:IF meno=7 THEN diskMarke
    WINDOW 9
    y2=128:GOSUB filename:IF f$="/" THEN diskMarke
    OPEN f$ FOR INPUT AS #1
    FOR n=0 TO 999
      INPUT#1,cs(meno,n)
    NEXT n
    CLOSE 1
    c=0:y=(meno-1)*24+2
    FOR m=0 TO 19
      FOR n=0 TO 49
        IF cs(meno,c)=0 THEN col=0:ELSE col=2
        PSET (2+n,y+m),col
        c=c+1
      NEXT n
    NEXT m
    GOSUB setName
    GOTO diskMarke

  Directory:
    y2=80:GOSUB filename:IF df$="" THEN diskMarke
    WINDOW 11,,(20,30)-(395,236),0,1
    COLOR 2:FILES df$
    COLOR 3:PRINT  "press any key";
    GOSUB continue
    WINDOW CLOSE 11

  diskMarke:
    WINDOW wi
    mess=2:GOTO messageFresh

  Loeschen:
    FOR n=0 TO 999
      cs(0,n)=0:cs(7,n)=0
    NEXT n
    LINE (1,1)-(399,159),0,bf
    IF colGitter=1 THEN colGitter=0:CALL Gitter(colGitter)
    nnbI=1:GOTO Sefresh

  Invertieren:
    me=1:GOTO LogikMarke
  PuANDSp:
    me=2:GOTO Logik
  PuORSp:
    me=3:GOTO Logik
  PuXORSp:
    me=4:GOTO Logik

    Logik:
      GOSUB getMENU:IF meno=7 THEN mess=3:GOTO messageFresh
    LogikMarke:
      c=0
      FOR m=1 TO 160 STEP 8
        FOR n=1 TO 400 STEP 8
          IF me=1 THEN
            cs(0,c)=ABS(cs(0,c)-1)
          ELSEIF me=2 THEN
            cs(0,c)=cs(0,c) AND cs(meno,c)
          ELSEIF me=3 THEN
            cs(0,c)=cs(0,c) OR cs(meno,c)
          ELSEIF me=4 THEN
            cs(0,c)=cs(0,c) XOR cs(meno,c)
          END IF
          LINE (n,m)-(n+6,m+6),cs(0,c)*3,bf
          cs(7,c)=cs(0,c)
          c=c+1
        NEXT n
      NEXT m
      nnbI=0
      IF me>1 THEN mess=3:GOTO messageFresh:ELSE GOTO Sefresh

  Gitter:
    CALL Gitter(colGitter)
    GOTO Sefresh

  scsRedraw:
    GOSUB just:c=0
    FOR m=1 TO 160 STEP 8
      FOR n=1 TO 400 STEP 8
        cs(0,c)=scsRescue(c):cs(7,c)=cs(0,c)
        LINE (n,m)-(n+6,m+6),cs(0,c)*3,bf
        c=c+1
      NEXT n
    NEXT m
    nnbI=0:mess=1:GOTO messageFresh

  SimModeII:
    smod=2

  SimModeI:
    FOR n=0 TO 999
      scsRescue(n)=cs(0,n)
      cs(7,n)=cs(0,n)
    NEXT n
    IF nnbI=1 THEN Simulationsende
    WINDOW OUTPUT 10:COLOR 2
    IF smod=2 THEN PRINT:PRINT  "any key continues after signal black-orange-black";
    PRINT:PRINT  "stop simulation with space";
    PRINT :csrl=CSRLIN:COLOR 2:PRINT "generation# 1";
    WINDOW OUTPUT 5
    GOSUB Simulationsinit
    IF xr<xl THEN Simulationsende
    an=0:na=7:ret=0:us=0:gennr=1:sgen=1
  SimModeMarke:
    yor=0:yur=0:xlr=0:xrr=0:yov=0:yuv=0:xlv=0:xrv=0:settest=0:a$=""
    gennr=gennr+1
    WINDOW OUTPUT 10:COLOR 2:LOCATE csrl,12:PRINT gennr;
    WINDOW OUTPUT 5
    FOR n=yo TO yu
      o=n-1:IF o=-1 THEN o=19
      u=n+1:IF u=20 THEN u=0
      of=o*50:uf=u*50
      FOR m=xl TO xr
        l=m-1:IF l=-1 THEN l=49
        r=m+1:IF r=50 THEN r=0
        nf=n*50
        a=cs(an,of+m)+cs(an,uf+m)+cs(an,nf+l)+cs(an,nf+r)
        IF neighbour=8 THEN a=a+cs(an,of+l)+cs(an,of+r)+cs(an,uf+l)+cs(an,uf+r)
        IF a<>stayat THEN
          IF a=liveat THEN c=1:ELSE c=0
          IF cs(an,nf+m)<>c THEN
            x=m*8+1:y=n*8+1:settest=1
            LINE (x,y)-(x+6,y+6),c*3,bf
          END IF
        ELSE
          c=cs(an,nf+m)
        END IF
        cs(na,nf+m)=c
        IF a$="" THEN a$=INKEY$
      NEXT m
    NEXT n
    IF a$=" " OR settest=0 THEN ret=1
    hyo=yo*50:hyu=yu*50
    FOR xx=xl TO xr
      IF cs(na,hyo+xx) THEN yor=1
      IF cs(na,hyu+xx) THEN yur=1
    NEXT xx
    FOR yy=yo TO yu
      IF cs(na,yy*50+xl) THEN xlr=1
      IF cs(na,yy*50+xr) THEN xrr=1
    NEXT yy
    yo=yo-yor:yu=yu+yur:xl=xl-xlr:xr=xr+xrr
    hyo=(yo+1)*50:hyu=(yu-1)*50
    FOR xx=xl+1 TO xr-1
      IF cs(na,hyo+xx) THEN yov=1
      IF cs(na,hyu+xx) THEN yuv=1
    NEXT xx
    FOR yy=yo+1 TO yu-1
      IF cs(na,yy*50+xl+1) THEN xlv=1
      IF cs(na,yy*50+xr-1) THEN xrv=1
    NEXT yy
    GOSUB SimulationstestI
    IF us THEN
      IF yo=2 THEN
        FOR y=yo TO yu:FOR x=xl TO xr:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        yo=y-2:us=0
      END IF
      IF yu=17 THEN
        FOR y=yu+1 TO yo STEP -1:FOR x=xl TO xr:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        yu=y+2:us=0
      END IF
      IF xl=2 THEN
        FOR x=xl-1 TO xr:FOR y=yo TO yu:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        xl=x-2:us=0
      END IF
      IF xr=47 THEN
        FOR x=xr+1 TO xl STEP -1:FOR y=yo TO yu:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        xr=x+2:us=0
      END IF
    END IF
    IF ret=1 AND na=0 THEN Simulationsende
    IF an=0 THEN an=7:na=0:ELSE an=0:na=7
    IF smod=2 AND ret=0 THEN GOSUB stepbystep
    GOTO SimModeMarke
    
    Simulationsende:
      smod=0:mess=4:GOTO messageFresh
          
    Simulationsinit:
      FOR x=0 TO 49:FOR y=0 TO 19:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        xl=x-1
      FOR y=0 TO 19:FOR x=0 TO 49:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        yo=y-1
      FOR x=49 TO 0 STEP -1:FOR y=0 TO 19:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        xr=x+1
      FOR y=19 TO 0 STEP -1:FOR x=0 TO 49:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
        yu=y+1
      GOSUB SimulationstestII
      RETURN

SimulationstestI:
  IF yor=0 AND yov=0 THEN yo=yo+1
  IF yur=0 AND yuv=0 THEN yu=yu-1
  IF xlr=0 AND xlv=0 THEN xl=xl+1
  IF xrr=0 AND xrv=0 THEN xr=xr-1
SimulationstestII:
  IF wi=5 THEN simu=19:simr=49:ELSE simu=49:simr=149
  IF yo<0    THEN yu=simu:yo=0:us=1
  IF yu>simu THEN yu=simu:yo=0:us=1
  IF xl<0    THEN xr=simr:xl=0:us=1
  IF xr>simr THEN xr=simr:xl=0:us=1
RETURN

filename:
  WINDOW 6,"prg request - name ...",(20,30)-(500,y2),0,1
  LOCATE 2,2:COLOR 2,0:PRINT "enter new name or just return":PRINT
  PRINT " directory name (old) : "df$
  INPUT " directory name (new) : ",ff$
  IF ff$<>"" AND ff$<>df$ THEN df$=ff$
  IF y2=>95 THEN
    IF y2=127 THEN
      GOSUB getRule
      PRINT
      PRINT " extension represents rules - current extension: .";rule$
      PRINT " (neighbour cells)(cell comes to live)(no change of state)"
      PRINT " extension automatically will be added while saving"
      PRINT
    ELSEIF y2=128 THEN
      PRINT 
      PRINT " you must enter the whole filename (including extension)"
      PRINT " when in doubt press return and use DIRECTORY from MENU"
      PRINT " after loading use CHANGE RULES to enter the new rule"
      PRINT 
    END IF
    INPUT " file name      (new) : ",nf$
    IF nf$<>"" AND y2=127 THEN nf$=nf$+"."+rule$
  END IF
  IF RIGHT$(df$,1)=":" THEN
    f$=df$+nf$
  ELSE
    f$=df$+"/"+nf$
  END IF
  IF df$="" OR nf$="" THEN f$="/"
  WINDOW CLOSE 6
RETURN

askRules:
  GOSUB getRule:WINDOW OUTPUT 10:COLOR 2:PRINT 
  PRINT "current rules:";neighbour;"neighbouring cells, comming"
  PRINT "to life at";liveat;"& stay at";stayat;"living neighbours"
  PRINT "in use: ";rule$;" - CHANGE RULES to enter new rules";
RETURN

getRule:
  h$=STR$(neighbour)
  rule$=RIGHT$(h$,LEN(h$)-1)
  h$=STR$(liveat)
  rule$=rule$+RIGHT$(h$,LEN(h$)-1)
  h$=STR$(stayat)
  rule$=rule$+RIGHT$(h$,LEN(h$)-1)
RETURN

getMENU:
  WINDOW OUTPUT 10:COLOR 2:PRINT :PRINT "choose memory (mem`s MENU)";
  getMENUmarke:
  men=MENU(0):IF men=0 THEN getMENUmarke
  meno=MENU(1):IF men<>5 THEN getMENUmarke
  IF wi=5 THEN PRINT:PRINT  "just a moment ...";
  WINDOW OUTPUT wi
RETURN

ColorReset:
  PALETTE 0,.1,.1,1
  PALETTE 1,0,0,0
  PALETTE 2,1,1,1
  PALETTE 3,1,.55,0
RETURN

stepbystep:  
  FOR m=1 TO 2
    PALETTE 3,0,0,0
    FOR n=1 TO 1000:NEXT n
    PALETTE 3,1,.55,0
    FOR n=1 TO 1000:NEXT n
  NEXT m        
  GOSUB continue
  IF a$=" " THEN ret=1:ELSE ret=0 
RETURN
  
continue:
  a$=""
  WHILE (a$="")
    a$=INKEY$
  WEND
RETURN

messageFresh:  
  IF mess>0 THEN WINDOW OUTPUT 10:COLOR 2:PRINT
  IF mess=1 THEN PRINT "copy terminated";
  IF mess=2 THEN PRINT "disk operation terminated";
  IF mess=3 THEN PRINT "logical operation terminated";
  IF mess=4 THEN PRINT "simulation terminated";
  IF mess=5 THEN PRINT "scs - ok";
  IF mess=6 THEN PRINT "ssm - ok";
  WINDOW OUTPUT wi
IF wi=5 THEN GOTO Sefresh:ELSE GOTO ssmRefresh
  
just:
  WINDOW OUTPUT 10:COLOR 2:PRINT :PRINT "just a moment ...";
  WINDOW OUTPUT wi
RETURN

setName:
  mem$=CHR$(96+meno)+": "+f$
  mem$=mem$+SPACE$(43-LEN(mem$))
  mem$=LEFT$(mem$,43)
  MENU 5,meno,1,mem$
RETURN

resetName:
  mem$=CHR$(96+meno)+": noname mem"+SPACE$(33)
  MENU 5,meno,1,mem$
RETURN

setMENU:
  IF wi=5 THEN nu=1:ELSE nu=0
  MENU 3,3,item(nu,8):MENU 3,4,item(nu,9):MENU 3,5,item(nu,10):MENU 3,6,item(nu,11):MENU 3,7,item(nu,12)
  MENU 4,2,item(nu,0):MENU 4,1,item(nu,1):MENU 4,5,item(nu,2):MENU 4,6,item(nu,3):MENU 4,4,item(nu,15)
  MENU 6,0,item(nu,4):MENU 6,1,item(nu,5):MENU 6,2,item(nu,6):MENU 6,3,item(nu,7)
  MENU 7,3,item(nu,13):MENU 7,4,item(nu,14)
RETURN

catchtheMouse:
  WHILE (MOUSE(0)<>0):WEND
  c=0
  WHILE (c=0)
    CALL ssmMouse(x,y,c)
  WEND
RETURN
  
SUB showMouse(x,y,wi) STATIC
  WINDOW OUTPUT 8:COLOR 2
  LOCATE 2,8:PRINT x"        "
  LOCATE 3,8:PRINT y"        ";
  WINDOW OUTPUT wi
END SUB

SUB ssmMouse(x,y,c) STATIC
  c=MOUSE(0):x=INT(MOUSE(1)/4):y=INT(MOUSE(2)/4)
  IF x>149 THEN x=149
  IF y>49 THEN y=49
  wi=3:CALL showMouse(x,y,wi)
END SUB

SUB ssmMouseII(x,y,c) STATIC
  c=MOUSE(0):x=INT(MOUSE(1)/4):y=INT(MOUSE(2)/4)
  IF x>100 THEN x=100
  IF y>30 THEN y=30
  wi=3:CALL showMouse(x,y,wi)
END SUB

SUB Gitter(colGitter) STATIC
  LINE (0,0)-(400,160),1,b
  IF colGitter=0 THEN colGitter=1:ELSE colGitter=0
  FOR n=8 TO 392 STEP 8
    LINE (n,1)-(n,159),colGitter
    IF n<153 THEN LINE (1,n)-(399,n),colGitter
  NEXT n
  IF colGitter=1 THEN
    MENU 3,7,1,"grid off            "
  ELSE
    MENU 3,7,1,"grid on             "
  END IF
END SUB

SUB ssmGitter STATIC
  LINE (0,0)-(600,200),1,b
  FOR n=4 TO 596 STEP 4
    LINE (n,1)-(n,199),1
    IF n<213 THEN LINE (1,n)-(599,n),1
  NEXT n
END SUB

SUB LocateMouse(x,y) STATIC
  x=INT(MOUSE(1)/8):y=INT(MOUSE(2)/8)
END SUB

SUB Fehleranzeige STATIC
  WINDOW OUTPUT 10:PRINT :PRINT "attention there`s an error"
  er=ERR
  IF er=53 THEN
     PRINT "53 - file not found";
  ELSEIF er=61 THEN
    PRINT "61 - disk full";
  ELSEIF er=64 THEN
    PRINT "64 - bad file name";
  ELSE
    PRINT "error#"ERR;
  END IF
END SUB

SUB rules(random,neighbour,liveat,stayat) STATIC
  DEFINT a-q,s-z
  WINDOW 6,"prg request - rules ...",(20,30)-(500,160),0,1
  lessormore=random*10-10:spaces$=SPACE$(80)
  resrandom=random:resneighbour=neighbour
  resliveat=liveat:resstayat=stayat
  FOR n=0 TO 3
    col(n)=1
  NEXT n

    CLS:GOSUB rulesRefresh
    x=440:y= 3:GOSUB drawcasual
    x=440:y=34:GOSUB drawneighbour
  inputRules:
    LOCATE 10,2:PRINT "enter new value or just return"
    col(0)=2:GOSUB rulesRefresh:col(0)=1
  again:
    LOCATE 12,2:PRINT spaces$
    LOCATE 12,2:INPUT "density for casual pattern (1 < 9): ",enter$
    IF enter$<>"" THEN
      enter=INT(VAL(enter$))
      IF enter<1 OR enter>9 THEN again
    ELSE
      enter=lessormore  
    END IF
    random=(enter+10)/10:lessormorehelp=lessormore:lessormore=enter
    IF lessormore<>lessormorehelp THEN x=440:y=3:GOSUB drawcasual
    col(1)=2:GOSUB rulesRefresh:col(1)=1
  onceagain:
    LOCATE 13,2:PRINT spaces$
    LOCATE 13,2:INPUT "number of neighbouring cells (4,8): ",enter$
    IF enter$<>"" THEN
      enter=INT(VAL(enter$))
      IF enter<>4 AND enter<>8 THEN onceagain
      neighbour=enter
    END IF
    IF neighbour<>resneighbour THEN x=440:y=34:GOSUB drawneighbour
    col(2)=2:GOSUB rulesRefresh:col(2)=1
  againandagain:
    LOCATE 14,2:PRINT spaces$
    LOCATE 14,2:PRINT "enter new value (";
                FOR n=1 TO neighbour
                  PRINT CHR$(48+n);
                  IF n<neighbour THEN PRINT ",";
                NEXT n
                INPUT "): ",enter$
    IF enter$<>"" THEN
      enter=INT(VAL(enter$))
      IF enter<1 OR enter>neighbour THEN againandagain
      liveat=enter
    ELSE
      IF liveat>neighbour THEN againandagain
    END IF
    col(3)=2:GOSUB rulesRefresh:col(3)=1
  lasttime:
    choice$=""
    FOR n=1 TO neighbour
      IF n<>liveat THEN choice$=choice$+CHR$(48+n)+","
    NEXT n
    choice$=LEFT$(choice$,LEN(choice$)-1)
    LOCATE 15,2:PRINT spaces$
    LOCATE 15,2:PRINT "enter new value (";choice$;:INPUT "): ",enter$
    IF enter$<>"" THEN
      enter=INT(VAL(enter$))
      IF enter<1 OR enter=liveat OR enter>neighbour THEN lasttime
      stayat=enter
    ELSE
      IF stayat>neighbour THEN lasttime
    END IF

    GOSUB rulesRefresh
    LINE (0,65)-(500,160),0,bf
    LOCATE 10,2:PRINT "  edit rules once more : 1"
    LOCATE 11,2:PRINT "oops! - use old values : 2"
    LOCATE 12,2:PRINT "Conway`s original LIFE : 3"
    LOCATE 13,2:PRINT "        use new values : return"
  MenueMarke:
    LOCATE 15,2:PRINT spaces$
    LOCATE 15,2:INPUT "your choice : ",enter$
    IF enter$="" THEN daswars
    IF enter$="1" THEN
      LINE (0,65)-(500,160),0,bf
      GOTO inputRules
    ELSEIF enter$="2" THEN
      random=resrandom:neighbour=resneighbour
      liveat=resliveat:stayat=resstayat
      GOTO daswars
    ELSEIF enter$="3" THEN
      neighbour=8:liveat=3:stayat=2
      GOTO daswars
    END IF
    GOTO MenueMarke
    
  daswars:
    WINDOW CLOSE 6:EXIT SUB
    
  rulesRefresh:
    COLOR 1:LOCATE 2,2:PRINT "current rules:"
    COLOR col(0):LOCATE 4,2
          PRINT "density for casual pattern   :";lessormore          
    COLOR col(1):LOCATE 5,2
          PRINT "number of neighbouring cells :";neighbour          
    COLOR col(2):LOCATE 6,2
          PRINT "cell comes to life at";liveat;"living neighbouring cells"
    COLOR col(3):LOCATE 7,2
          PRINT "cell does not change at";stayat;"living neighbouring cells"     
    COLOR 1:LINE (0,64)-(500,64)
  RETURN
  
  drawneighbour:
    LINE (x,y)-(x+32,y+22),0,bf
    LINE (x+12,y+8)-(x+20,y+14),2,bf
    LINE (x+12,y)-(x+20,y+6),3,bf:LINE (x+24,y+8)-(x+32,y+14),3,bf
    LINE (x,y+8)-(x+8,y+14),3,bf:LINE (x+12,y+16)-(x+20,y+22),3,bf
    IF neighbour=8 THEN
      LINE (x,y)-(x+8,y+6),3,bf:LINE (x+24,y)-(x+32,y+6),3,bf      
      LINE (x,y+16)-(x+8,y+22),3,bf:LINE (x+24,y+16)-(x+32,y+22),3,bf
    END IF
  RETURN

  drawcasual:
    RANDOMIZE TIMER
    FOR m=0 TO 24
      FOR n=0 TO 36
        setit=INT(RND(1)*random)
        PSET(x+n,y+m),setit*2
      NEXT n
    NEXT m
  RETURN
END SUB