Quelltext von TORWART

/* Simulation TORWART: Diffusion Limited Agregation */

MODULE 'intuition/intuition'

   /* Spielfeldgroesse */
   CONST XFELDSIZE=640, YFELDSIZE=400

   CONST PARTIKELZAHL=5000            

   /* Zaehlvariable*/
   DEF partikel                       

   /* Aktuelle Koordinaten des Partikels */
   DEF xkoor                          
   DEF ykoor

   /* Ja/Nein */
   DEF beruehrung

   /* Zufallsvariable */                   
   DEF schrittrichtung

   /* Partikelposition im `mem'-Array */
   DEF belegtposition                 
   DEF x,xx,y
   
   /* Startposition des Partikels */
   DEF anfangx,anfangy

   /* Spielfeldgroesse in Zellen */
   DEF arraysize:LONG              


   DEF hilf:LONG

   /* Variablen fuer Programmfenster */
   DEF wflag                        
   DEF iflag
   DEF winpointer
   DEF mymsg

   /* Interne Programmkennzeichnung */
   DEF progversion[80]:STRING

   /* Pointer auf Speicherbereich des Spielfelds */
   DEF mem:LONG                    

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

PROC main()
   arraysize:=((XFELDSIZE+1)*(YFELDSIZE+1))+1

   /* Speicher fuer Spielfeld belegen */
   mem:=New(arraysize) 
   IF mem=0
      WriteF('Sorry, nicht genug Speicher f"ur TORWART!\n')
      CleanUp(10)
   ENDIF

   /* Belegung der Variblen: */
   progversion:='$VER: TORWART Version 7 vom 26.04.98'

   /* Fenster oeffnen */
   iflag:=IDCMP_CLOSEWINDOW+IDCMP_INTUITICKS 
   wflag:=2+4+8+$400+$1000
   winpointer:=
             OpenW(0,14,XFELDSIZE+10,YFELDSIZE+27,iflag,wflag,'TORWART',NIL,1,NIL)
   IF winpointer=0
      WriteF('Sorry, no Window --> no TORWART!\n')
      CleanUp(10)
   ENDIF

   /* Spielfeld vorbereiten: Zellen loeschen*/
   FOR x:=0 TO XFELDSIZE
      xx:=x*XFELDSIZE
      FOR y:=0 TO YFELDSIZE
         PutChar(mem+xx+y,0)
       ENDFOR
   ENDFOR

   /* Kathodenposition festlegen */
   anfangx:=XFELDSIZE-(XFELDSIZE/3)
   anfangy:=YFELDSIZE/2
   PutChar(mem+(anfangx*XFELDSIZE+anfangy),1)
   feldmalen()

   /* Programmschleife */
   FOR partikel:=1 TO PARTIKELZAHL
      TextF(1,YFELDSIZE+9,'Partikel \d ',partikel)
      mymsg:=WaitIMessage(winpointer)
      IF mymsg=IDCMP_CLOSEWINDOW
         CloseW(winpointer)
         CleanUp(0)
      ENDIF

      /* Startposition des Partikels auswuerfeln */
      xkoor:=20
      ykoor:=(YFELDSIZE/4)+Rnd(YFELDSIZE/2)
      Plot(xkoor,ykoor,3)
      beruehrung:=FALSE

      /* Lauf eines einzelnen Partikels */
      WHILE beruehrung=FALSE

         /* Schrittrichtung auswuerfeln */
         schrittrichtung:=Rnd(4)
         IF schrittrichtung=0
            xkoor:=xkoor+1
         ELSEIF schrittrichtung=1
            ykoor:=ykoor-1
         ELSEIF schrittrichtung=2
            xkoor:=xkoor-1
         ELSEIF schrittrichtung=3
            ykoor:=ykoor+1
         ENDIF

         IF xkoor=0 THEN xkoor:=1
         IF xkoor=XFELDSIZE THEN xkoor:=XFELDSIZE-1
         IF ykoor=0 THEN ykoor:=1
         IF ykoor=YFELDSIZE THEN ykoor:=YFELDSIZE-1

         belegtposition:=mem+(xkoor*XFELDSIZE)+ykoor

         IF Char(belegtposition-1)=1
            beruehrung:=TRUE
         ELSEIF Char(belegtposition+1)=1
            beruehrung:=TRUE
         ELSEIF Char(belegtposition-XFELDSIZE)=1
            beruehrung:=TRUE
         ELSEIF Char(belegtposition+XFELDSIZE)=1
            beruehrung:=TRUE
         ELSEIF Char(belegtposition-XFELDSIZE-1)=1
            beruehrung:=TRUE
         ELSEIF Char(belegtposition+XFELDSIZE-1)=1
            beruehrung:=TRUE
         ELSEIF Char(belegtposition-XFELDSIZE+1)=1
            beruehrung:=TRUE
         ELSEIF Char(belegtposition+XFELDSIZE+1)=1
            beruehrung:=TRUE
         ENDIF

      ENDWHILE

      /* aktuelle Position fuer die Zukunft als Kathodenteil kennzeichnen */
      PutChar(belegtposition,1)

      /* Fensterinhalt aktualisieren */
      Plot(xkoor,ykoor,2)
   ENDFOR


   /* Zum Programmende nocheinmal das ganze Spielfeld neu malen */
   feldmalen()


   /* Warten, bis der Benutzer das Prgramm beendet */
   WHILE WaitIMessage(winpointer)<>IDCMP_CLOSEWINDOW
   ENDWHILE

   /* Fenster schliessen und Programm beenden */
   CloseW(winpointer)
   CleanUp(0)
ENDPROC



/* Spielfeld im Programmfenster darstellen */
PROC feldmalen()
   Box(0,0,XFELDSIZE,YFELDSIZE,1)
   FOR x:=0 TO XFELDSIZE
      xx:=x*XFELDSIZE
      FOR y:=0 TO YFELDSIZE
         IF Char(mem+xx+y)<>0 THEN Plot(x,y,2)
      ENDFOR
   ENDFOR
   Box(20,(YFELDSIZE/4),20,(YFELDSIZE/4)+(YFELDSIZE/2),5)
   Plot(anfangx,anfangy,5)
ENDPROC



Zum vorigen Kapitel - Zum Inhalt - Zum nächsten Kapitel

Homepage von Bernd Schäfer