von H.Schönfeld und B.Spellenberg


SURROUND Teil 2

<SM> steht für das SEMIKOLON

Der (heiß ersehnte?) Quellcode
Wie angekündigt bringen wir in dieser
Ausgabe den Quick Quellcode des
Spieles. Der Programmablauf wurde ja
schon in der letzten Folge erklärt. So
können wir uns diesesmal auf den
ausführlich kommentierten Quelltext
(immerhin 40%) beschränken.


Trotzdem noch ein paar Bemerkungen:

Im ARRAY FELD sind die drei
Schafspositionen und die Wolfsposition
gespeichert. Dabei können Werte von 0
bis 10 angenommen werden.
In der Tabelle TO stehen zu jedem Feld
alle von diesem Feld aus erreichbaren
Felder. Hier sind die Feldnummern
allerdings von 1 bis 11 (bzw. 201 bis
210) durchnummeriert! Das hat nur den
Sinn 0 als Endekennung für die
Tabelleneinträge benutzen zu können.

Eine Besonderheit liegt im Abspeichern
und Laden der Schwarzen Liste. Hier
müssen ja 2 Variablen(felder)
abgespeichert werden. Zunächst die
WORD- Variable STELLANZ, dann das ARRAY
LOST.
Um das geschickt durchzuführen haben
wir folgenden Weg gewählt: Zuerst wird
die WORD-Variable ADR auf die Adresse
208/209 gelegt. Dann wird mit Hilfe des
Befehls VADR(STELLANZ) die Adresse von
STELLANZ in ADR geschrieben. Nun kann
mit den BPUT- Befehl BPUT(1,2,ADR) der
Inhalt von STELLANZ abgespeichert
werden. Dann holt man sich mit
VADR(LOST) die Adresse von LOST und
speichert mit BPUT(1,166,ADR) das ARRAY
ab. Beim Laden macht man es genauso.

Zur Darstellung wird Grafik 2 mit
Textfenster benutzt. Dabei wird der
Grafikbildschirm auf Kanal 5 geöffnet.
So ist es möglich mit dem LPT-Befehl
auf diesen Bildschirm zu drucken. Der
PRINT-Befehl läuft weiterhin über das
Grafik 0 Textfenster.


Achtung: (+ und )+ stehen für die
eckigen Klammern


Quick-Sourcetext
D1:SURROUND.KOM 
----------------
Length: $34A7
Free  : $42C4
----------------

* SURROUND Version 0.5
* (C) '91 HYPERON SOFT
* eine Schafe & Wolf Variante

* Selbstlernendes Spielprogramm


 BYTE
 (+
  STOP     *Flag fuer Prg.Ende
  ZUG      *Zugzaehler
  RES      *Zielfeld des Wolfs
  STELLANZ *Anzahl der Stellungen in
           *der schwarzen Liste
 )+

 ARRAY
 (+
  LOST(166)     *Schwarze Liste
  FX(12),FY(12) *BS Koordinaten
                *der Felder
  FELD(4)       *akt. Stellung
  FELD2(4)      *Stellung vor Schafzug
  TO(99)        *Erreichbare Felder
  HASHFELD(4)   *zu markier. Stellung
  RNDTAB(10)   *skalierte Zufallszahlen
  MASKTAB(8)    *Bitfolge fuer Hashing
 )+


MAIN

* Initialisierung
  .INIT
* Programm Anfangsmeldung
  .PAM
  
  REPEAT
* Spiel aufbauen
    .SETUP

    REPEAT

* Schafzug einlesen
      .GETMOVE
* Stellung zeigen
      .SHOW
* Wolfzug berechnen
      .CALCMOVE(RES)
* Wolfzug ausfuehren
      .MOVE(RES)
* Stellung zeigen
      .SHOW

    UNTIL RES>127    *Bis Spielende

* Abfrage auf Neuanfang oder Ende
    .CONT

* Bis STOP von CONT() auf 1 gesetzt
  UNTIL STOP=1

ENDMAIN


* Programm Anfangsmeldung
PROC PAM
 LOCAL
  ARRAY
  (+
   LL(2)     *Ein-Zeichen-String
  )+
  WORD
  (+
   ADR=208   *Rueckgabevar. fuer VADR()
  )+
BEGIN

* BS oeffnen
  CLOSE(6)
  OPEN(6,12,0,"E:")
  ?("UMZINGELN")
  ?("Version 0.5")
  ?("H.Schoenfeld & B.Spellenberg")
  ?("programmiert in QUICK V2.0")
  ?
  ?("Schwarze Liste laden (+J/N)+")

  INPUT (LL)

* Falls LL="J", Schwarze Liste laden
  IF LL(0)=74
    CLOSE(1)
    OPEN(1,4,0,"D:SL")
* Laenge der Schwarzen Liste
* in STELLANZ laden
    VADR(STELLANZ)
    BGET(1,2,ADR)
* Liste in LOST laden
    VADR(LOST)
    BGET(1,166,ADR)
    CLOSE(1)
    ?("Liste mit ",STELLANZ)<SM>
    ?("Stellungen geladen")
* 4 Sekunden warten
    .WAIT(200)
  ENDIF
ENDPROC  


* Abfrage auf Neustart oder Spielende

PROC CONT
 LOCAL
  WORD
  (+
   ADR=208      *Adresse fuer VADR
  )+
  ARRAY
  (+
   STR(2)       *Einzeichen String
  )+
BEGIN

  ?("Noch ein Spiel (+J/N)+")
  INPUT(STR)

* Wenn <> "J" Spielende
  IF STR(0)<>74
    ?("Liste abspeichern")
    INPUT(STR)
* Spielende auf 1
    STOP=1
* Wenn "J" Liste abspeichern
    IF STR(0)=74
      CLOSE(1)
      OPEN(1,8,0,"D:SL")
      VADR(STELLANZ)
      BPUT(1,2,ADR)
      VADR(LOST)
      BPUT(1,166,ADR)
      CLOSE(1)
      ?("Liste mit ",STELLANZ)<SM>
      ?("Stellungen gespeichert")
    ENDIF
  ENDIF
ENDPROC


* Variablen und Felder Initialisierung

PROC INIT
 LOCAL
  BYTE
  (+
   I
  )+

BEGIN


* Schwarze Liste initialisieren
  I=0
  REPEAT
    LOST(I)=0
    I+
  UNTIL I=166
  STELLANZ=0


* Kein Prg.Ende
  STOP=0

* X und Y BS-Position des Iten Feldes
  DATA(FX)
  (+
  5,7,7,7,9,9,9,11,11,11,13
  )+
  DATA(FY)
  (+
  5,3,5,7,3,5,7,3,5,7,5
  )+

* Erreichbare Felder
* Jeweils 8 Eintraege pro Startfeld
* plus 1 Nullbyte
* Wenn Felder nur fuer Wolf erreichbar
* (nach links) 200 addiert
  DATA(TO)
  (+
  2,3,4,0,0,0,0,0,0
  3,5,6,201,0,0,0,0,0
  2,4,6,201,0,0,0,0,0
  3,6,7,201,0,0,0,0,0
  6,8,202,0,0,0,0,0,0
  5,7,8,9,10,202,203,204,0
  6,10,204,0,0,0,0,0,0
  9,11,205,206,0,0,0,0,0
  8,10,11,206,0,0,0,0,0
  9,11,206,207,0,0,0,0,0
  208,209,210,0,0,0,0,0,0
  )+

* Die zur Darstellung der Zufallszahl
* benoetigten Bits, aufgefuellt bis
* zur naechsten Stufenzahl-1
  DATA(RNDTAB)
  (+
  0,0,1,3,3,7,7,7,7
  15,15
  )+
* Bitmaske
  DATA(MASKTAB)
  (+
  1,2,4,8,16,32,64,128
  )+
ENDPROC


* Neues Spiel beginnen
PROC SETUP
 LOCAL
  BYTE
  (+
   CH=756  *Zeichensatz Anfangsadr.
  )+
BEGIN

* Anfangsposition
  DATA(FELD)
  (+
  0,1,3,5
  )+

* 1. Zug
  ZUG=1

* Auf Kanal 5 Grafik 2 oeffnen
  CLOSE(5)
  OPEN(5,24,2,"S:")
  SETCOL(0,0,0)
* Grafikzeichensatz anschalten
  CH=226

* Stellung zeigen
  .SHOW
ENDPROC


* Stellung zeichnen

PROC SHOW
 LOCAL
  BYTE
  (+
   I,NR,X,Y
  )+
  ARRAY
  (+
   STR(20)   *Grafikzeichenstring
  )+

BEGIN

* Strings mit Grafikzeichen fuer
* Spielfeld definieren und ausgeben
* auf Kanal 5 (=Grafik 3 BS)

  DATA(STR)
  (+
  239,146,239,146,239,0
  )+
  POS(7,3)
  LPT(STR)<SM>

  DATA(STR)
  (+
  134,252,135,252,134,252,135,0
  )+
  POS(6,4)
  LPT(STR)<SM>
  
  DATA(STR)
  (+
  239,146,239,146,239,146,239,146,239,0
  )+
  POS(5,5)
  LPT(STR)<SM>

  DATA(STR)
  (+
  135,252,134,252,135,252,134,0
  )+
  POS(6,6)
  LPT(STR)<SM>

  DATA(STR)
  (+
  239,146,239,146,239,0
  )+
  POS(7,7)
  LPT(STR)<SM>

* Die 4 Steine an ihrer Position
* ausgeben
  I=0
  REPEAT
    NR=FELD(I)
    X=FX(NR)
    Y=FY(NR)
    IF I<3          *Schafe
      COLOR(20)
    ELSE            *Wolf
      COLOR(180)
    ENDIF
    PLOT(X,Y)
    I+
  UNTIL I=4
ENDPROC


* Schafszug mit Joystick einlesen

PROC GETMOVE
 LOCAL
  BYTE
  (+
   NR      *Derzeit angewaehltes Feld
   START,ZIEL *Start- Zielfeld des
           *eingegebenen Zuges
   SCHAF   *Nummer des angewaehlten
           *Schafs
   I,J,H
   SF      *Flag fuer Neueingabe
  )+
BEGIN

  SF=1
  ?("Startfeld waehlen ")<SM>

* Anfangsfeld des Cursors auf Pos. des
* ersten Schafs
  NR=FELD(0)

* Stellung vor Schafszug sichern
  I=0
  REPEAT
    H=FELD(I)
    FELD2(I)=H
    I+
  UNTIL I=4

* Zugeingabe
  REPEAT

* Joystick-Abfrage
* NR: Anfangs- und Endpos. des Cursors
    .GET_STICK(NR,NR)

* Startfeld eingeben?
    IF SF=1
* Suchen, ob Schaf auf Startfeld sitzt
      I=0
      REPEAT
        H=FELD(I)
        IF H=NR
* Nummer in START merken
* Schaf in SCHAF merken
          IF NR<>10
            SCHAF=I
            START=NR
* nun Zielfeld waehlen
            SF=0
            ?("und Zielfeld waehlen")
            I=2
          ENDIF
        ENDIF
        I+
      UNTIL I=3
    ELSE
      
* Ueberpruefe ob Zielfeld von Startfeld
* erreichbar ist
      MULT(START,9,I) *Index fuer Tab.
      REPEAT
* Moegl. Felder aus Tabelle lesen
        H=TO(I)
        H-

* und vergleichen.
* Wenn gefunden: Ueberpruefen ob Feld
* frei ist
        IF H=NR
          ZIEL=NR
          J=0
          REPEAT
            H=FELD(J)

            IF H=ZIEL
* Wenn besetzt, neues Startfeld waehlen
              JUMP(2)
            ENDIF
            J+
          UNTIL J=4
* Wenn leer: Sprung ans Ende
          JUMP(1)
        ENDIF
* Sobald Feld nur von Wolf zu erreichen
* Suche beenden
        IF H>128
          H=0
        ENDIF
        I+
      UNTIL H=0
-2
      SF=1
      ?("Neues Startfeld ")<SM>
    ENDIF
  UNTIL 1=0

-1
* Schaf ans Ziel bewegen
  FELD(SCHAF)=ZIEL

ENDPROC


* Joystick Abfragen

PROC GET_STICK
 IN
  BYTE
  (+
   NR      *Anfangsfeld des Cursors
  )+
 OUT
  BYTE
  (+
   NEWNR   *Endfeld des Cursors
  )+
 LOCAL
  BYTE
  (+
   STICK=632,STRIG=644  * OS-Variable
   SX,SY       *Cursorposition
   ALT         *Org. Bildschirminhalt
   FLAG        *Joystick betaetigt
   UP,DW,LF,RI *Richtungsflags
  )+
BEGIN

  REPEAT

* Derzeitige Pos. bestimmen
    SX=FX(NR)
    SY=FY(NR)
    POS(SX,SY)
* Zeichen dort merken
    LOCATE(ALT)
    
* Cursor dort setzen
    COLOR(224)
    PLOT(SX,SY)

* Warten
    .WAIT(15)

* Warten bis Stick bewegt oder Trigger
* gedrueckt
    REPEAT
      FLAG=1
      IF STICK=15
        IF STRIG=1
          FLAG=0
        ENDIF
      ENDIF
    UNTIL FLAG<>0
    .WAIT(2)

* Richtungen ausmaskieren
    AND(STICK,1,UP)
    AND(STICK,2,DW)
    AND(STICK,4,LF)
    AND(STICK,8,RI)

* Je nach Richtungen neues Feld
* berechnen
    IF LF=0
      IF NR=10
        NR=8
      ELSE
        SUB(NR,3,NR)
      ENDIF
    ENDIF
    IF RI=0
      IF NR=0
        NR=2
      ELSE
        ADD(NR,3,NR)
      ENDIF
    ENDIF
    IF UP=0
      NR-
    ENDIF
    IF DW=0
      NR+
    ENDIF

* Ueberlaufkorrektur
    IF NR>128
      NR=0
    ELSE
      IF NR>9
        NR=10
      ENDIF
    ENDIF

* Alten Inhalt herstellen
    COLOR(ALT)
    PLOT(SX,SY)

* bis Trigger gedrueckt
  UNTIL STRIG=0

* Rueckgabefeld setzen
  NEWNR=NR

ENDPROC


* Warte TIM/50 Sekunden

PROC WAIT
 IN
  BYTE
  (+
   TIM=540
  )+
BEGIN
  REPEAT
  UNTIL TIM=0
ENDPROC


* Wolfszug berechnen

PROC CALCMOVE
 OUT
  BYTE
  (+
   ERG     *Zielfeld
  )+
 LOCAL
  BYTE
  (+
   MOEGZ   *Anzahl der moegl. Zuege
   GOODZ   *Anzahl der Zuege die nicht
           *in Verluststellung fuehren
   FLAG    *Flag ob Feld frei ist
   RND     *Zufallszahl
   H,I
  )+
  ARRAY
  (+
   MOEG(10) *Liste der moegl. Zuege
   GOOD(10) *Liste der guten Zuege
  )+
BEGIN

* Derzeitige Wolfsposition
  H=FELD(3)
* Index in Tabelle
  MULT(H,9,I)

* erstes erreichbares Feld ermitteln
  H=TO(I)

* Falls Feld nur fuer Wolf erreichbar
* Feldnummer normalisieren
  IF H>200
    SUB(H,200,H)
  ENDIF

* Zaehler des Zuglisten auf loeschen
  MOEGZ=0
  GOODZ=0

* Alle erreichbaren Felder untersuchen
  WHILE H<>0
    FLAG=0
    H-

* Untersuchen, ob Feld besetzt
    IF H=FELD(0)
      FLAG=1
    ELSE
      IF H=FELD(1)
        FLAG=1
      ELSE
        IF H=FELD(2)
          FLAG=1
        ENDIF
      ENDIF
    ENDIF

* Falls Feld unbesetzt
    IF FLAG=0
* Feld in die Liste der moeglichen
* Zuege eintragen
      MOEG(MOEGZ)=H
      MOEGZ+
* Untersuchen, ob dieser Zug in der 
* schwarzen Liste vermerkt ist
      .HASH(H,FLAG)
      IF FLAG=0
* Falls nicht, Zug auf in die Liste
* der guten Zuege eintragen 
        GOOD(GOODZ)=H
        GOODZ+
      ENDIF
    ENDIF

* naechstes erreichbares Feld ermitteln
    I+
    H=TO(I)

    IF H>200
      SUB(H,200,H)
    ENDIF

  WEND

* H mit nicht moegl. Feld vorbelegen
  H=127

* Falls keine guten Zuege moeglich sind
  IF GOODZ=0

* Die Stellung vor dem letzten
* Schafszug in die schwarze Liste
* eintragen
    .MARK
    IF MOEGZ=0
* Falls ueberhaupt keine Zuege moeglich
* sind
      ERG=-1
    ELSE
* sonst zufaellig einen moeglichen Zug
* auswaehlen
      .RAND(MOEGZ,RND)
      ERG=MOEG(RND)
      ERG+
      H=ERG
    ENDIF
  ELSE
* sonst zufaelling einen guten Zug
* auswaehlen
    .RAND(GOODZ,RND)
    ERG=GOOD(RND)
    ERG+
    H=ERG
  ENDIF

* Falls bereits 15 Zuege gespielt
  IF ZUG>15
* Wolf hat gewonnen (ERG > 127)
    ADD(ERG,200,ERG)
  ELSE
* Ueberpruefen, ob der Wolf sich links
* von allen Schafen befindet
    IF H<FELD(0)
      IF H<FELD(1)
        IF H<FELD(2)
* sicherstellen, dass der naechste Zug
* nicht nach rechts geht
          I=0
          REPEAT
            IF ERG>GOOD(I)
              ERG=GOOD(I)
              ERG+
            ENDIF
            I+
          UNTIL I=GOODZ
* Wolf hat gewonnen (ERG > 200)
          ADD(ERG,200,ERG)
        ENDIF
      ENDIF
    ENDIF
  ENDIF

ENDPROC    
  

* Zufallszahlen Generator

PROC RAND
 IN
  BYTE
  (+
   MAX      * Obergrenze
  )+
 OUT
  BYTE
  (+
   RESULT   * Rueckgabewert
  )+
 LOCAL
  BYTE
  (+
   RANDOM=53770 * OS-Variable
   A
  )+
BEGIN

* Bitmuster zum Maximalwert auslesen
  A=RNDTAB(MAX)

  REPEAT
    AND(RANDOM,A,RESULT)
  UNTIL RESULT<MAX

ENDPROC


* Zug ausfuehren

PROC MOVE
 IN
  BYTE
  (+
   ERG    * auszufuehrender Zug
  )+
BEGIN

  IF ERG=-1
    ?("Die Schafe haben gewonnen")
  ELSE
* Falls Wolf (noch) nicht gewonnen
    IF ERG<128
* Zug normal ausfuehren
      ZUG+
      ERG-
      FELD(3)=ERG
      ?("Zug Nummer:",ZUG)
    ELSE
* Falls mehr als 15 Zuege
      IF ZUG>=16
        ?("Mehr als 15 Zuege.")
      ELSE
        ?("Wolf ist durchgebrochen.")
      ENDIF
      ?("Der Wolf hat gewonnen")
* Zug normalisieren & ausfuehren
      SUB(ERG,201,ERG)
      FELD(3)=ERG
    ENDIF
  ENDIF

ENDPROC

* Schwarze Liste befragen

PROC HASH
 IN
  BYTE
  (+
   WOLFFELD     * Wolfsposition
  )+
 OUT
  BYTE
  (+
   HRES         * Situtation markiert?
  )+
 LOCAL
  BYTE
  (+
   MASKE        * zu pruefendes Bit
   OFFSET       * zu pruefendes Byte
   A,B,C,T
  )+
BEGIN

* Wolfpos. eintragen
  HASHFELD(3)=WOLFFELD

* Schafspositionen sortieren
  A=FELD(0)
  B=FELD(1)
  C=FELD(2)
  IF A>B
    T=A
    A=B
    B=T
  ENDIF
  IF B>C
    T=B
    B=C
    C=T
  ENDIF
  IF A>B
    T=A
    A=B
    B=T
  ENDIF

* Schafspositionen eintragen
  HASHFELD(0)=A
  HASHFELD(1)=B
  HASHFELD(2)=C

* aus HASHFELD zupruefendes Bit & Byte
* berechnen
  .NUMBER(OFFSET,MASKE)

* dieses Bit zurueckgeben
  T=LOST(OFFSET)
  AND(T,MASKE,HRES)

ENDPROC


* Stellung in schwarze Liste eintragen

PROC MARK
 LOCAL
  BYTE
  (+
   MASKE        * zu setzendes Bit
   OFFSET       * zu setzendes Byte
   A,B,C,T,O,M
  )+
BEGIN

* Schafspositionen sortieren
  A=FELD2(0)
  B=FELD2(1)
  C=FELD2(2)
  IF A>B
    T=A
    A=B
    B=T
  ENDIF
  IF B>C
    T=B
    B=C
    C=T
  ENDIF
  IF A>B
    T=A
    A=B
    B=T
  ENDIF

* Schafs & Wolfspositionen eintragen
  HASHFELD(0)=A
  HASHFELD(1)=B
  HASHFELD(2)=C
  T=FELD2(3)
  HASHFELD(3)=T

* aus HASHFELD zupruefendes Bit & Byte
* berechnen
  .NUMBER(OFFSET,MASKE)

* pruefen, ob gewuenschtes Bit bereits
* gesetzt ist
  O=LOST(OFFSET)
  AND(O,MASKE,M)
  IF M=0
* wenn nicht Stellung in Liste
* eintragen
    STELLANZ+
    OR(O,MASKE,O)
    LOST(OFFSET)=O
    ?("Neue Stellung Nr. ",STELLANZ)
  ENDIF

ENDPROC


* Position einer Stellung in der
* schwarzen Liste berechnen

PROC NUMBER
 OUT
  BYTE
  (+
   OFFSET    * zu berechnendes Byte 
             * der Adresse
   MASKE     * zu berechnendes Bit der
             * Adresse
  )+
 LOCAL
  BYTE
  (+
   A,B,C,D,INDEX
  )+
  WORD
  (+
   TEMP,TEMP1
  )+
BEGIN

* HASHFELD auslesen
  D=HASHFELD(3)
  A=HASHFELD(0)
  B=HASHFELD(1)
  C=HASHFELD(2)

* Position berechnen
  IF C>D
    C-
    IF B>D
      B-
      IF A>D
        A-
      ENDIF
    ENDIF
  ENDIF  

  MULT(-2,B,TEMP)
  ADD(TEMP,30,TEMP)
  MULT(TEMP,B,TEMP)
  MULT(6,A,TEMP1)
  SUB(TEMP,TEMP1,TEMP)
  SUB(TEMP,34,TEMP)
  MULT(TEMP,B,TEMP)

  MULT(TEMP1,9,TEMP1)
  ADD(TEMP,TEMP1,TEMP)
  MULT(C,6,C)
  ADD(TEMP,C,TEMP)
  DIV(TEMP,6,TEMP)

  MULT(D,120,TEMP1)
  ADD(TEMP,TEMP1,TEMP)
  SUB(TEMP,1,TEMP)

  DIV(TEMP,8,OFFSET)
  AND(TEMP,7,INDEX)
  MASKE=MASKTAB(INDEX)

ENDPROC