'
' KILLER.PRG       Version 1.2      16.Juni 1989
'
' geschrieben von: Uwe Mller
'                  Humboldtstr.29
'                  4000 Dsseldorf 1
'
' ************************************************************************
'
' Variablenliste mit Erl„uterungen:
' ---------------------------------
' a$               geretteter Bildschirminhalt bei ™ffnen eines Fensters
' m$               Ausgabetext einer Alertbox
' var%             angew„hlter Button einer Alertbox
' feld1!()
' feld2!()
' x%,y%            relative Feldkoordinaten
' kx%,ky%          Koordinaten der bei Spielerstart angeklickten Felder
' nx%,ny%          Koordinaten der Nachbarfelder des Feldes x,y
' zn%              Anzahl der 'bewohnten' Nachbarfelder des Feldes x,y
' xalt%,yalt%      Koordinaten des alten Killerfeldes
' xneu%,yneu%           "       "  neuen      "
' checkvar%        Prfvariable: legaler Killerzug -> 1, Spieler verloren -> 2;
' gen_counter%     Anzahl der Zellengenerationen (Wachstumsdurchl„ufe)
' cellcounter%        "    "  lebenden Zellen
' zeit%            bisher ben”tigte Gesamtbedenkzeit des Spielers
' gesamtzellen%    Gesamtzahl aller bisher vernichteten Zellen
' high_score%      Nomen est omen
' counter%         Anzahl der Startzellen
' wertung%         W.~ des gerade beendeten Spieles
'
' ***************************************************************************
'
IF XBIOS(4)<>2 THEN
  m$=" Dieses Programm l„uft nur | mit Monochrom-Monitor."
  ALERT 3,m$,1,"Sch....!",var%
  END
ENDIF
CLEAR
DIM feld1!(19,19)
DIM feld2!(19,19)
IF EXIST("KILLER.DAT")=-1 THEN   ! Existiert die Highscore-Datei?
  OPEN "I",#1,"KILLER.DAT"       ! Ja, er”ffne Lesezugriff auf sie.
  INPUT #1,high_score%           ! Schreibe ihren Inhalt in die Variable
  CLOSE #1                       ! high_score%.
ENDIF
'
' Felddarstellung
'
DEFFILL ,2,4                     ! Fllmuster mittelgrau.
PBOX 0,0,640,400                 ! Bildschirm "fllen".
DEFFILL ,0,1                     ! Fllmuster weiž.
PBOX 15,15,385,385               ! Žužeren Rahmen zeichnen.
BOX 18,18,382,382
BOX 19,19,381,381
x%=1                             ! Eigentliche Spielfelder zeichnen.
REPEAT
  y%=1
  REPEAT
    BOX x%*20,y%*20,x%*20+20,y%*20+20
    INC y%
  UNTIL y%>18
  INC x%
UNTIL x%>18
PBOX 410,21,600,90                ! Menboxen zeichnen.
BOX 412,23,598,88
BOX 413,24,597,87
PBOX 460,117,560,152
PBOX 460,165,560,200
PBOX 460,213,560,248
PBOX 460,261,560,296
PBOX 460,309,560,344
PRINT AT(62,9);"Info";
PRINT AT(62,12);"Hilfe";
PRINT AT(60,15);"Edit game";
PRINT AT(61,18);"New game";
PRINT AT(62,21);"Quit";
GOSUB info
'
'
warmstart:                                ! Sprungmarke nach 'New game'.
CLR gen_counter%,gesamtzellen%,zeit%
ARRAYFILL feld2!(),0                      ! Feld 2 wird genullt.
xalt%=18                                  ! x-Koordinate des Killers
yalt%=18                                  ! y-    "       "     "
GOSUB computerstart
GOSUB zeichnen
DO                      ! Endlosschleife wird einmal pro Generation durchlaufen.
  t=TIMER               ! Zeitnahme fr High score.
  hauptschleife:
  DO                    ! Diese Endlosschleife fragt alle Mausereignisse ab,
    checkvar%=0         ! wenn der Killer am Zug ist.
    IF MOUSEK=1 THEN                        ! linke Maustaste?
      xneu%=MOUSEX\20                       ! Umrechnen der Mauskoordinaten auf
      yneu%=MOUSEY\20                       ! Felderkoordinaten.
      IF MOUSEX>460 AND MOUSEX<560 THEN     ! Menboxen? (als da w„ren:..)
        IF MOUSEY>117 AND MOUSEY<152 THEN   ! Infobox
          GOSUB info
          GOTO hauptschleife
        ENDIF
        IF MOUSEY>165 AND MOUSEY<200 THEN   ! Hilfebox
          GOSUB help
          GOTO hauptschleife
        ENDIF
        IF MOUSEY>213 AND MOUSEY<248 THEN   ! Edit-game-Box
          GOSUB spielerstart
          GOTO hauptschleife
        ENDIF
        IF MOUSEY>261 AND MOUSEY<296 THEN   ! New-game-Box
          GOTO warmstart
        ENDIF
        IF MOUSEY>309 AND MOUSEY<344 THEN             ! Quit-Box
          ALERT 2,"Wirklich?",2," Ja | Nein ",var%
          IF var%=1 THEN
            GOSUB schluss
          ENDIF
        ENDIF
      ENDIF
      IF xneu%=0 OR xneu%>18 THEN    ! Klick aužerhalb von Spielfeld und Boxen?
        GOTO hauptschleife           ! Ja, Schleife neu beginnen.
      ENDIF
      IF yneu%=0 OR yneu%>18 THEN    ! dto. ?
        GOTO hauptschleife
      ENDIF
      IF xneu%=xalt%+2 AND yneu%=yalt%+1 THEN         ! Und jetzt:
        GOSUB killerzug(xneu%,yneu%)                  ! Abfrage aller legalen
      ENDIF                                           ! Killerzge.
      IF xneu%=xalt%+2 AND yneu%=yalt%-1 THEN
        GOSUB killerzug(xneu%,yneu%)
      ENDIF
      IF xneu%=xalt%+1 AND yneu%=yalt%+2 THEN
        GOSUB killerzug(xneu%,yneu%)
      ENDIF
      IF xneu%=xalt%+1 AND yneu%=yalt%-2 THEN
        GOSUB killerzug(xneu%,yneu%)
      ENDIF
      IF xneu%=xalt%-1 AND yneu%=yalt%+2 THEN
        GOSUB killerzug(xneu%,yneu%)
      ENDIF
      IF xneu%=xalt%-1 AND yneu%=yalt%-2 THEN
        GOSUB killerzug(xneu%,yneu%)
      ENDIF
      IF xneu%=xalt%-2 AND yneu%=yalt%+1 THEN
        GOSUB killerzug(xneu%,yneu%)
      ENDIF
      IF xneu%=xalt%-2 AND yneu%=yalt%-1 THEN
        GOSUB killerzug(xneu%,yneu%)
      ENDIF
      IF feld2!(xneu%,yneu%)=0 AND checkvar%=1 THEN  ! War das neue Killerfeld
        GOTO weiter                                  ! unbewohnt (und war es
      ENDIF                                          ! ein legaler Killerzug)?
    ENDIF
  LOOP
  weiter:                      ! Ja! : Zellen sind mit Wachstum dran.
  ADD zeit%,(TIMER-t)\200      ! Killerbedenkzeit wird gestoppt.
  xalt%=xneu%                  ! xneu,yneu ist jetzt das neue Killerfeld
  yalt%=yneu%
  SWAP feld1!(),feld2!()       ! Die briggebliebenen Zellen werden nach Feld 1
  GOSUB verloren               ! geschrieben.
  IF checkvar%=2 THEN          ! Hatte der Spieler verloren?
    GOTO warmstart
  ENDIF
  GOSUB wachstum               ! Die neuen Zellen werden erzeugt
  GOSUB zeichnen               ! und auf dem Bildschirm ausgegeben.
  IF cellcounter%=0 THEN       ! Ist keine Zelle mehr brig?
    GOSUB gewonnen             ! Dann hat der Spieler gewonnen.
    GOTO warmstart
  ENDIF
LOOP                           ! Und die neue Generation beginnt wieder mit
'                              ! dem Killer am Zug.
'
' ***************************************************************************
' Prozedurensammlung:
'
PROCEDURE computerstart        ! Erzeugung der Startzellen per Zufallszahl.
  DO
    counter%=0                 ! Der Z„hler fr die Startzellen.
    x%=8                       ! In die mittleren sechzehn Felder von Feld 2
    REPEAT                     ! wird mit der Zufallsfunktion entweder eine 0
      y%=8                     ! (Feld unbewohnt) oder eine -1 (Zelle entstan-
      REPEAT                   ! den) geschrieben.
        feld2!(x%,y%)=RANDOM(-2)    ! N„mlich hier.
        IF feld2!(x%,y%)=-1 THEN    ! Zelle entstanden?
          INC counter%              ! Ja, also erh”he Z„hler.
        ENDIF
        INC y%
      UNTIL y%=12
      INC x%
    UNTIL x%=12
    EXIT IF counter%=7         ! Wurde bei diesem Durchlauf die Sollzahl von
  LOOP                         ! 7 Startzellen erzeugt, dann abbrechen, sonst
RETURN                         ! weiterschleifen.
'
'
PROCEDURE ende
  PAUSE 50
  m$="Du hast verloren! |Willst du Rache?"
  ALERT 1,m$,1," Klaro | Nee ",var%
  IF var%=2 THEN
    GOSUB schluss
  ELSE
    INC checkvar%
  ENDIF
RETURN
'
'
PROCEDURE gewonnen
  GOSUB statistik
  ALERT 3,"Glckwunsch!|Alle Zellen sind vernichtet. |Noch ein Spiel?",1," ja | nein ",var%
  IF var%=2 THEN
    GOSUB schluss
  ENDIF
  PUT 45,25,a$
RETURN
'
'
PROCEDURE help
  GET 395,20,633,390,a$               ! Bildschirminhalt in a$ einlesen.
  DEFFILL ,0,1                        ! Fllmuster weiž.
  PBOX 395,20,633,390                 ! Und Fenster ”ffnen.
  BOX 397,22,631,388
  BOX 398,23,630,387
  PRINT AT(52,3);"Ziel des Spieles ist, mit  ";
  PRINT AT(52,4);"dem Killer (der schwarze   ";
  PRINT AT(52,5);"Kreis in der unteren Ecke) ";
  PRINT AT(52,6);"alle Zellen zu vernichten. ";
  PRINT AT(52,7);"Diese wachsen immer dann,  ";
  PRINT AT(52,8);"wenn der Killer auf ein un-";
  PRINT AT(52,9);"bewohntes Feld zieht.      ";
  PRINT AT(52,10);"Der Killer zieht wie ein   ";
  PRINT AT(52,11);"Springer im Schachspiel,   ";
  PRINT AT(52,12);"also zwei Felder vertikal  ";
  PRINT AT(52,13);"und eins horizontal oder   ";
  PRINT AT(52,14);"umgekehrt. Man klickt ein- ";
  PRINT AT(52,15);"fach das Zielfeld an - das ";
  PRINT AT(52,16);"Programm prft dabei auf   ";
  PRINT AT(52,17);"Legalit„t und ignoriert    ";
  PRINT AT(52,18);"falsche Zge.              ";
  PRINT AT(52,19);"Aber Vorsicht! Wenn die    ";
  PRINT AT(52,20);"Zellen ber den Rand hinaus";
  PRINT AT(52,21);"wachsen, hat man verloren. ";
  PRINT AT(52,22);"Es erfolgt dann eine Mel-  ";
  PRINT AT(52,23);"dung per Alertbox.         ";
  PRINT AT(52,24);"     (Weiter mit Mausklick)";
  PAUSE 20
  REPEAT
  UNTIL MOUSEK<>0                    ! Warte bis Maustaste.
  PUT 395,20,a$                      ! Bildschirm restaurieren.
  PAUSE 20
RETURN
'
'
PROCEDURE info
  GET 70,70,330,330,a$               ! Bildschirm retten.
  DEFFILL ,0,1                       ! Fllmuster weiž.
  PBOX 70,70,330,330                 ! Fenster auf.
  BOX 72,72,328,328
  BOX 73,73,327,327
  BOX 90,90,310,130
  DEFTEXT 1,5,0,20                   ! Text grož, kursiv, fett.
  TEXT 110,118,180,"KILLER"
  DEFTEXT 1,16,0,13                  ! Text normal, outlined
  TEXT 140,160,"Version 1.2"
  DEFTEXT 1,0,0,6                    ! Texth”he 8
  TEXT 144,180,"½  16.6.1989"
  TEXT 87,260,"geschrieben in GfA-Basic 2.0"
  TEXT 87,273,230,"Das Programm ist Public Domain!"
  PRINT AT(12,13);"       Uwe Mller";
  PRINT AT(12,14);"       Humboldtstr.29";
  PRINT AT(12,15);"       4000 Dsseldorf 1";
  PRINT AT(12,19);"High score: ";high_score%;
  DEFTEXT 1,0,0,4
  TEXT 87,320,"(Weiter mit Maustaste)"
  REPEAT
  UNTIL MOUSEK<>0                     ! Warte auf Maustaste
  PUT 70,70,a$                        ! Bildschirm restaurieren
  PAUSE 20
RETURN
'
'
PROCEDURE killerzug(xneu%,yneu%)
  feld2!(xalt%,yalt%)=0               ! Zelle auf altem Killerfeld l”schen.
  INC checkvar%                       ! Prfvariable (fr legalen Zug) setzen.
  DEFFILL ,0,1                                     ! Fllmuster weiž.
  PBOX xalt%*20,yalt%*20,xalt%*20+20,yalt%*20+20   ! Altes und neues Killerfeld
  PBOX xneu%*20,yneu%*20,xneu%*20+20,yneu%*20+20   ! auf Bildschirm l”schen.
  DEFFILL ,2,8                                     ! Fllmuster schwarz.
  PCIRCLE xneu%*20+10,yneu%*20+10,9   ! Killer neu zeichnen.
  xalt%=xneu%                         ! Schon fr den n„chsten Zug wird das
  yalt%=yneu%                         ! neue Killerfeld zum alten.
  IF feld2!(xneu%,yneu%)=-1 THEN      ! War neues Killerfeld v. Zelle bewohnt?
    INC gesamtzellen%                 ! Erh”he Gesamtzahl vernichteter Zellen.
    DEC cellcounter%                  ! Erniedrige Z„hler lebender Zellen.
    PRINT AT(55,5);cellcounter%;" lebende Zellen ";
  ENDIF
RETURN
'
'
PROCEDURE probe(kx%,ky%)              ! Prft auf Legalit„t der vom Spieler
  IF (kx%\20)>7 AND (kx%\20)<12 THEN  ! gesetzten Startzellen bei "Edit game".
    IF (ky%\20)>7 AND (ky%\20)<12 THEN
      DEFFILL ,2,7                    ! Fllmuster dunkelgrau.
      FILL (kx%\20)*20+5,(ky%\20)*20+5  ! Zelle auf Bildschirm zeichnen...
      feld2!(kx%\20,ky%\20)=-1          ! ...und in Array eintragen.
      PAUSE 10                        ! Um 'langsame' Mausklicks auszugleichen.
      INC counter%                    ! Zellenz„hler erh”hen.
    ENDIF
  ENDIF
RETURN
'
'
PROCEDURE schluss
  IF high_score%>0 THEN          ! Die Highscore-Datei 'KILLER.DAT' wird natr-
    OPEN "o",#1,"KILLER.DAT"     ! lich nur geschrieben bzw. neu eingerichtet,
    PRINT #1,high_score%         ! wenn auch ein Highscore vorliegt.
    CLOSE #1
  ENDIF
  END
RETURN
'
'
PROCEDURE spielerstart
  CLR gesamtzellen%,gen_counter%,zeit%  ! Erstmal alles auf Null setzen,
  ARRAYFILL feld2!(),0                  ! alle Zellen l”schen,
  xalt%=18                              ! Killer auf Anfangsfeld setzen,
  yalt%=18
  GOSUB zeichnen                        ! ...und alles auf Bildschirm ausgeben.
  x%=8                                  ! Die Feldmarkierungen, in die die
  REPEAT                                ! Startzellen vom Spieler hineingesetzt
    y%=8                                ! werden sollen, werden gezeichnet.
    REPEAT
      BOX x%*20+2,y%*20+2,x%*20+18,y%*20+18
      INC y%
    UNTIL y%>11
    INC x%
  UNTIL x%>11
  GET 395,20,633,390,a$   ! Retten des Bildschirmes
  DEFFILL ,0,1            ! Fllmuster weiž
  PBOX 395,20,633,390     ! und das Fenster fr die Erkl„rung zeichnen.
  BOX 397,22,631,388
  BOX 398,23,630,387
  PRINT AT(52,3);"Normalerweise werden bei   ";
  PRINT AT(52,4);"Spielstart vom Computer ge-";
  PRINT AT(52,5);"nau sieben Zellen per Zu-  ";
  PRINT AT(52,6);"fallszahl erzeugt.         ";
  PRINT AT(52,7);"Mit dieser Option kann nun ";
  PRINT AT(52,8);"der Spieler die Startzellen";
  PRINT AT(52,9);"selber setzen. Dazu klickt ";
  PRINT AT(52,10);"er einfach mit der Maus in ";
  PRINT AT(52,11);"die markierten Felder. Es  ";
  PRINT AT(52,12);"mssen auch nicht unbedingt";
  PRINT AT(52,13);"sieben Zellen sein - der   ";
  PRINT AT(52,14);"Spieler hat freie Auswahl. ";
  PRINT AT(52,15);"Allerdings wird nur bei    ";
  PRINT AT(52,16);"genau sieben Startzellen   ";
  PRINT AT(52,17);"die Spielwertung als High- ";
  PRINT AT(52,18);"score bernommen, so daž   ";
  PRINT AT(52,19);"dieser vergleichbar bleibt.";
  PRINT AT(52,21);"Die Eingabe wird mit rech- ";
  PRINT AT(52,22);"tem Mausklick abgeschlos-  ";
  PRINT AT(52,23);"sen.                       ";
  counter%=0
  DO
    IF MOUSEK=1 THEN               ! Wurde eine Startzelle gesetzt...
      GOSUB probe(MOUSEX,MOUSEY)   ! ...prfen, ob sie in ein legales Feld
    ENDIF                          ! gesetzt wurde.
    EXIT IF MOUSEK=2               ! Abbrechen nach rechter Maustaste.
  LOOP
  PUT 395,20,a$                    ! Bildschirm restaurieren.
  CLR gen_counter%                 ! Generationenz„hler nullen.
  GOSUB zeichnen                   ! Bildschirmausgabe.
RETURN
'
'
PROCEDURE statistik
  wertung%=(600*gesamtzellen%)^2\(zeit%^2*gen_counter%)
  GET 45,25,350,135,a$
  DEFFILL ,0,1
  PBOX 45,25,350,135
  BOX 47,27,348,133
  BOX 48,28,347,132
  PRINT AT(8,3);"Insgesamt vernichtete Zellen: ";USING "####",gesamtzellen%;
  PRINT AT(8,4);"Ben”tigte Zeit in Sekunden:   ";USING "####",zeit%;
  PRINT AT(8,5);"Vernichtete Zellen/Minute:    ";USING "####",60*gesamtzellen%\zeit%;
  PRINT AT(8,7);"Erreichte Spielwertung:     ";USING "######",wertung%;
  PRINT AT(8,8);"Bisheriger High score:      ";USING "######",high_score%
  IF counter%=7 THEN
    IF high_score%<wertung% THEN
      high_score%=wertung%
    ENDIF
  ENDIF
RETURN
'
'
PROCEDURE verloren  !Prft vor dem Zellenwachstum, ob der Spieler verloren hat.
  y%=1
  REPEAT
    IF feld1!(1,y%)=-1 AND feld1!(1,y%+1)=-1 THEN  ! Sitzen am Rand zwei Zellen
      GOSUB ende                                   ! unmittelbar nebeneinander,
      GOTO exit                                    ! hat der Spieler verloren,
    ENDIF                                          ! da beim n„chsten Wachstum
    IF feld1!(18,y%)=-1 AND feld1!(18,y%+1)=-1 THEN  ! die Zellen ber den Rand
      GOSUB ende                                     ! hinauswachsen wrden,
      GOTO exit                                    ! also gerade die Verlust-
    ENDIF                                          ! bedingung.
    INC y%                 ! Selbstverst„ndlich ist dieser Programmteil nicht
  UNTIL y%=19              ! ordentlich gel”st. Bei Verlust wird aus dieser
  IF checkvar%=2 THEN      ! Prozedur in die Prozedur 'ende' gesprungen (Alert-
    GOTO exit              ! box-Ausgabe), und von dort aus in die Prozedur
  ENDIF                    ! 'schluss', die einen evtl. High score abspeichert
  x%=1                     ! und dann endlich das Programm beendet (ein Sprung
  REPEAT                   ! durch drei Prozeduren, ohne sie ordnungsgem„ž ab-
    IF feld1!(x%,1)=-1 AND feld1!(x%+1,1)=-1 THEN   ! zuschliežen - der erfah-
      GOSUB ende                                    ! rene Programmierer rauft
      GOTO exit                                     ! sich die Haare). Mir fiel
    ENDIF                                           ! aber nichts Eleganteres
    IF feld1!(x%,18)=-1 AND feld1!(x%+1,18)=-1 THEN ! ein, sei's drum.
      GOSUB ende
      GOTO exit
    ENDIF
    INC x%
  UNTIL x%=19
  exit:
RETURN
'
'
PROCEDURE wachstum
  x%=1
  REPEAT
    y%=1
    REPEAT
      zn%=0                                ! Nachbarfeldabfrage
      nx%=x%-1                             ! nx%,ny%=Nachbarkoordinaten
      REPEAT                               ! zn%=Anzahl der Nachbarzellen
        ny%=y%-1
        REPEAT
          IF feld1!(nx%,ny%)=-1 THEN       ! zn% wird auch fr das eigentliche
            INC zn%                        ! Feld (x%,y%) erh”ht, daher muž von
          ENDIF                            ! zn% gleich wieder 1 subtrahiert
          INC ny%                          ! werden.
        UNTIL ny%>y%+1
        INC nx%
      UNTIL nx%>x%+1
      IF feld1!(x%,y%)=-1 THEN             ! Neue Zellgeneration.
        DEC zn%                            ! s.o.
        feld2!(x%,y%)=(0<zn% AND zn%<4)
      ELSE
        feld2!(x%,y%)=1<zn%
      ENDIF
      INC y%
    UNTIL y%=19
    INC x%
  UNTIL x%=19
  feld2!(xneu%,yneu%)=0
RETURN
'
'
PROCEDURE zeichnen
  cellcounter%=0
  x%=1
  REPEAT
    y%=1
    REPEAT
      IF feld2!(x%,y%)=-1 THEN
        DEFFILL ,2,7
        PBOX x%*20+2,y%*20+2,x%*20+18,y%*20+18
        INC cellcounter%
      ELSE
        DEFFILL ,0,1
        PBOX x%*20,y%*20,x%*20+20,y%*20+20
      ENDIF
      INC y%
    UNTIL y%>18
    INC x%
  UNTIL x%>18
  DEFFILL ,2,8
  PCIRCLE xalt%*20+10,yalt%*20+10,9
  INC gen_counter%
  PRINT AT(55,3);gen_counter%;". Generation "
  PRINT AT(55,5);cellcounter%;" lebende Zellen  "
RETURN
