Vor einiger Zeit hatte ich, aus der Langeweile heraus, versucht das alte Computerspiel Bananenwerfen in Fortran zu implementieren. Da ich mich damals mit den grafischen Methoden Fortrans noch nicht so aus kannte, habe ich alles für die Konsole/Textzeile geschrieben, aber es hat funktioniert. Ich hoffe, das Programm funktioniert noch. Habe es seit dem nicht getestet. Würde mich über Kommentare und Testreporte freuen. Also lasst die Bananen fliegen! :)

Habe mal noch das original QBasic-Program hochgeladen. Wer möchte, kann das ja auch mal ausprobieren, wenn er noch einen alten QBasic-Interpreter zu Hause rumliegen hat: Gorilla.bas

Das Hauptprogramm:

• PROGRAM bananenwerfen
• use bananen_mod
• IMPLICIT NONE
•  
• REAL(kind=8),PARAMETER :: g=9.80665, pi = 3.1415926535897
•  
• TYPE affe
• CHARACTER(len=20) :: name
• INTEGER :: x,y
• LOGICAL :: getroffen
• END TYPE affe
•  
• REAL,DIMENSION(:),ALLOCATABLE :: stadt
• INTEGER,DIMENSION(:,:),ALLOCATABLE :: spielfeld
• INTEGER :: i,j,runden,breite,hoehe,spieleranzahl,spieleruebrig
• INTEGER :: aktuell,step,startzahl=1,haushoehe
• REAL :: winkel,kraft,pos,schrittweite=1.,x,y,z
• TYPE(affe),DIMENSION(:),ALLOCATABLE:: spieler
• CHARACTER(len=3) :: char_breite,char_hoehe,x1,x2
• CHARACTER(len=1) :: richtung,weiter
• LOGICAL :: getroffen
•  
• do
• write(*,'(A)',advance='no') 'Anzahl der Spieler (min. 2): '
• read(*,*) spieleranzahl
• if(spieleranzahl>=2) exit
• end do
•  
• spieleruebrig = spieleranzahl
• breite = 80; write(char_breite,'(I3)') breite
• hoehe = 20; write(char_hoehe,'(I3)') hoehe
• runden = 10
• haushoehe = 6
• schrittweite = 0.2
•  
• allocate(spieler(0:spieleranzahl-1),spielfeld(hoehe,breite),stadt(breite))
• spieler(:)%name=''
• do
• spielfeld = 0
• stadt = 0
•  
• ! Zufaellige Haeuserhoehen erstellen
• do i=1,breite
• do
• call random_seed()
• call random_number(z)
• stadt(i) = aint(z * haushoehe)+1
• if(i==0 .OR. abs(stadt(i)-stadt(i-1))<=3) exit
• end do
• end do
•  
• ! Die Haeuser in das Spielfeld aufnehmen
• do i=1,breite
• do j=int(hoehe-stadt(i)+1),hoehe
• spielfeld(j,i) = 1
• end do
• end do
•  
• ! Die Spieler erstellen
• do i=0,spieleranzahl-1
• if(spieler(i)%name=='') then
• write(*,'(A,I2,A)',advance='no') 'Name Spieler ',i+1,': '
• read(*,*) spieler(i)%name
• end if
• spieler(i)%getroffen = .false.
• x = breite/spieleranzahl
• if(x<5) then
• write(*,*) '*** Fehler: Spielfeld ist zu schmal fuer so viele Spieler'
• stop
• elseif(x>breite) then
• write(*,*) '*** Fehler: Probleme bei der Berechnung der Spielerpositionen'
• stop
• end if
• call random_seed()
• call random_number(z)
• spieler(i)%x = int(i*x + int(z * x)+1)
• spieler(i)%y = stadt(spieler(i)%x)+1
•  
• spielfeld(hoehe-spieler(i)%y+1,spieler(i)%x) = 2
• end do
•  
•  
• spiel: do i=0,spieleranzahl*runden-1
• aktuell = mod(i,spieleranzahl)
• if(.not. spieler(aktuell)%getroffen) then
• write(x1,'(I3)') spieler(aktuell)%x-1
• write(x2,'(I3)') breite-spieler(aktuell)%x
•  
• call put(spielfeld)
• write(*,'("o")',advance='no')
• if(spieler(aktuell)%x /= 1) write(*,'('//x1//'("="))', advance='no')
• write(*,'("^")',advance='no')
• if(spieler(aktuell)%x /= breite) write(*,'('//x2//'("="))',advance='no')
• write(*,'("o")')
•  
• write(*,'(A,I2,A,I2)',advance='no') 'Noch ',runden-i/spieleranzahl,' Schuss Munition vorhanden'
• write(*,'(A)') ' ['//trim(spieler(aktuell)%name)//' ist dran]'
•  
• do
• write(*,'(A)',advance='no') '- Winkel (0-90 Grad): '
• read(*,*) winkel
• if(0<=winkel .AND. winkel<90) exit
• end do
• winkel = bogenmass(winkel)
• do
• write(*,'(A)',advance='no') '- Welche Richtung (l,r): '
• read(*,*) richtung
• if(richtung=='l' .OR. richtung=='r') exit
• end do
• do
• write(*,'(A)',advance='no') '- Kraft (0-30 Kmh): '
• read(*,*) kraft
• if(0<=kraft .AND. kraft<=30) exit
• end do
•  
• x = real(spieler(aktuell)%x)
• step = 1
• if(richtung == 'l') then
• winkel = -winkel
• step = -1
• end if
•  
• flug: do
• if(x<1 .OR. x>breite) exit flug ! Wenn die Banane ueber das Spielfeld hinaus fliegt, beenden
•  
• ! Wurfparabel berechnen
• y = hoehe-(wurf(x-spieler(aktuell)%x,winkel,kraft)+spieler(aktuell)%y)
• if(int(y)>hoehe .OR. int(y)<0) then
• x = x+step*schrittweite
• else
• do j=0,spieleranzahl
• getroffen = (int(x)==spieler(j)%x .and. int(y)==hoehe-spieler(j)%y+1)
• if(getroffen) exit
• end do
• if(getroffen) then
• spielfeld(int(y),int(x)) = 5
• write(*,'(A)') trim(spieler(j)%name)//' wurde getroffen'
• spieler(j)%getroffen = getroffen
• spieleruebrig = spieleruebrig-1
• if(spieleruebrig==1) then
• write(*,'(A)') trim(spieler(aktuell)%name)//' hat gewonnen.'
• exit spiel
• end if
• exit flug
• elseif(spielfeld(int(y),int(x))==1 .OR. spielfeld(int(y),int(x))==4) then ! Wenn Banane ein Haus trifft,
• spielfeld(int(y),int(x)) = 4 ! dann Feld auf getroffen setzen
• write(*,*) 'Nur ein Haus getroffen'
• exit flug
• else
• spielfeld(int(y),int(x)) = 3 ! Wurfbahn einzeichnen
• x = x+step*schrittweite
• end if
• end if
• end do flug
• end if
• end do spiel
• call put(spielfeld)
• write(*,'("o",'//char_breite//'("="),"o")')
• if(i==(spieleranzahl*runden-1)) write(*,*) 'Ihr habt keine Munition mehr. Das Spiel ist zu Ende.'
• write(*,'(A)',advance='no') 'Nochmal? (j,n): '
• read(*,*) weiter
• if(weiter == 'n') exit
• end do
•  
• END PROGRAM bananenwerfen

Das zugehöriges Modul:

• module bananen_mod
• implicit none
•  
• public
•  
• contains
•  
• FUNCTION wurf(x,winkel,kraft)
• REAL(kind=8) :: wurf
• REAL :: winkel,kraft,x
• wurf = tan(winkel)*x-(g*(x**2))/(2*kraft**2*cos(winkel)**2)
• END FUNCTION
•  
• SUBROUTINE put(feld)
• INTEGER,DIMENSION(:,:),INTENT(out) :: feld
• INTEGER :: i,j
•  
• write(*,'("o",'//char_breite//'("="),"o")')
•  
• do i=1,size(feld,1)
• write(*,'("|")',advance='no')
• do j=1,size(feld,2)
• select case(feld(i,j))
• case(1); write(*,'(A1)',advance='no') '#' ! Hause
• case(2); write(*,'(A1)',advance='no') 'X' ! Affe
• case(3)
• write(*,'(A1)',advance='no') '*' ! Banane
• feld(i,j) = 0
• case(4); write(*,'(A1)',advance='no') 'O' ! getroffenes Haus
• case(5); write(*,'(A1)',advance='no') '%' ! Toter Affe
• case DEFAULT; write(*,'(A1)',advance='no') ' '
• end select
• end do
• write(*,'("|")')
• end do
•  
• END SUBROUTINE put
•  
• FUNCTION bogenmass(winkel)
• REAL(kind=8) :: bogenmass
• REAL,INTENT(in) :: winkel
• bogenmass = (winkel*pi)/180
• END FUNCTION
•  
• end module