home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.BIN / magazin / optix / disk1 / optxppac.set / TOMATO.OPT < prev    next >
Text File  |  1995-03-22  |  2KB  |  77 lines

  1. def(i)
  2. def(j)
  3. def(flg)
  4. def(k)
  5. def(mx,320)
  6. def(my,120)
  7. def(x)
  8. def(y)
  9.  
  10. defs(mid$)
  11. defs(dum$)
  12. defs(ins$,'1')
  13.  
  14. begin
  15.  
  16.   readsound('zusch.snd')
  17.   readpic('tomate.bmp')
  18.   setallpal
  19.   sysfont(3,1)
  20.   clearscreen(6)
  21.   keycol(255)
  22.   key(on)
  23.   dum$:='-----------------------------------'
  24.  
  25.   for j:=0 to 4 do
  26.     for i:=0 to 6 do
  27.       viewport(20+i*80,20+j*80,20+i*80+74,20+j*80+70)
  28.       plateau(15,0)
  29.       decviewport
  30.       plateau(15,0)
  31.     next(i)
  32.   next(j)
  33.  
  34.   setcolor(0)
  35.   printc(320,454,'vektorkontrolliertes Zufallsraster')
  36.   printc(320,470,'ohne Doppelbelegung')
  37.   setcolor(0)
  38.   setbcolor(15)
  39.  
  40.   j:=0
  41.  
  42.   repeat
  43.  
  44.     random(7,x)                         Zufalls-X-Koord.
  45.     random(5,y)                         Zufalls-Y-Koord.
  46.     mid$:=dum$
  47.     mid(mid$,y*7+x+1,1)                 entsprechenden Vektoreintrag holen
  48.     val(mid$,k,flg)                     in num. Wert wandeln
  49.     if k<>1
  50.       startsound
  51.       for i:=0 to 11 do
  52.         pause(20)
  53.         loadsprite(i*32+1,0,40+x*80,40+y*80,31,31)
  54.       next(I)
  55.       for i:=0 to 3 do
  56.         pause(20)
  57.         loadsprite(i*64+1,32,24+x*80,24+y*80,63,63)
  58.       next(I)
  59.       delete(dum$,y*7+x+1,1)            für neuen Eintrag Platz machen
  60.       i:=y*7+x+1
  61.       insert(ins$,dum$,i)               Vektorplatz ist ab jetzt belegt
  62.       viewport(20+x*80,20+y*80,20+x*80+74,20+y*80+70)
  63.       plateau(0,15)
  64.       decviewport
  65.       plateau(0,15)
  66.       printc(320,430,'VEKTOR: '+dum$)   zur Kontrolle ausgeben
  67.       inc(j,1)
  68.     endif
  69.  
  70.   until j>=35
  71.  
  72.   pause(5000)
  73.  
  74. end
  75.  
  76.  
  77.