'pingpong2.bas by Volta


Type racket
  As Single x,y
  Private:
  As Integer b,h,f,c,xmin,xmax,halb
  Public:
  Declare Constructor
  Declare Sub set_werte (w1 As Integer, w2 As Integer, w3 As Integer, w4 As Integer)
  Declare Property Aufschlag As Integer
  Declare Property Punkt As Integer
  Declare Property Punkt ( As Integer)As Integer
  Declare Property xpos As Single
  Declare Sub loeschen
  Declare Sub zeichnen
  Declare Sub Bewegungsgrenzen(pl As Integer)
  Declare Sub bewegen (dx As Single, dy As Single)
  Declare Function Grundpos As Integer
End Type


Type ball
  As Single x,y
  As Single xs,ys
  Private:
  As Integer r,f
  Public:
  Declare Constructor
  Declare Sub steuerung
  Declare Sub Aufschlagposition(pl As Integer)
  Private:
  Declare Sub loeschen
  Declare Sub zeichnen
  Declare Function trifft (r As racket) As Integer
End Type

Const As UInteger bg =RGBA(20,50,20,0), fg =&hffff00, rf =&Hff0000 'Farben
Const As Integer hr =80     'Höhe Racket
Const As Integer rb =10      'Breite Racket
Const As Integer br =8      'Radius Ball
Const As Integer fkt =200   'Faktor für Geschw.
Const As Integer glinie =20 'Abstand Grundlinie zum Bildrand

Declare Sub Mittellinie
Declare Sub auto_racket
Declare Sub spieler
Declare Sub Aufschlag(player As Integer)
Declare Sub aus

Screen 18,32,,1
Color fg,bg
Cls
Dim Shared As Integer breite, hoehe, automat, halbbreit
Locate 10,20
Input;"Spielfeld 1 - 4 "; automat
Select Case automat
  Case 0,1
  Case 2
    Screen 19,32,,1
  Case 4
    Screen 21,32,,1
  Case Else
    Screen 20,32,,1
End select
Color fg,bg
cls
Randomize Timer

ScreenInfo breite, hoehe
SetMouse 0,0,0

Dim Shared As Single vs
vs=hoehe/fkt         'Reaktionsgeschw. der Rackets

halbbreit = breite\2
Dim Shared b As ball

Dim Shared As racket p,c
p.set_werte(halbbreit+40, hoehe, halbbreit+(glinie*3), breite-glinie)
c.set_werte(halbbreit-40, hoehe, halbbreit-(glinie*3)-rb, glinie-rb)

Dim t As Double = Timer+900 'Zeitlimit 900sek
Aufschlag(0)
Do
  Sleep 1
  b.steuerung
  spieler
  auto_racket
  ScreenSync
Loop Until InKey=Chr(27) Or t<Timer 'ESC oder Zeitlimit
Cls
aus
End

Constructor ball
This.r=br         'Radius Ball
This.f=fg      'Ballfarbe
End Constructor

Sub ball.loeschen
  Circle (x, y), r, bg,,,,F 'Ball löschen
  If (x > halbbreit-r) And (x < halbbreit+r) Then
    Mittellinie 'zeichnen
  End If
End Sub

Sub ball.zeichnen
  y += ys
  x += xs
  Circle (x, y), r, f,,,,F 'Ball zeichnen
End Sub

Sub ball.Aufschlagposition(pl As Integer)
  x=IIf(pl = 1,p.aufschlag-(r*2),c.aufschlag+(r*3)) 'Aufschlagposition
  y=hoehe/2
  xs=IIf(pl = 1,breite/-fkt,breite/fkt)'Geschw. x
  ys=(Rnd*4)-2'Geschw. y
End Sub

Function ball.trifft (r As racket) As Integer'Ball getroffen?
  Function = ((x-br > r.x) And (x-br < r.x+rb) And (y > r.y) And (y < r.y+hr)) Or _
  (           (x+br > r.x) And (x+br < r.x+rb) And (y > r.y) And (y < r.y+hr)) Or _
  (              (x > r.x) And (x < r.x+rb) And (y-br > r.y) And (y-br < r.y+hr)) Or _
  (              (x > r.x) And (x < r.x+rb) And (y+br > r.y) And (y+br < r.y+hr))
End Function

Sub ball.steuerung
  loeschen
  If (x <= r) Then Aufschlag(1) 'Ball nicht getroffen
  If (x >= breite-r) Then Aufschlag(2)
  If trifft (c) Then'Ball getroffen
    xs=-xs+(Rnd*c.xpos/fkt)
    ys+=(Rnd*2)-2
  End If
  If trifft (p) Then
    xs=-xs-(Rnd*(breite -p.xpos)/fkt)
    ys+=(Rnd*2)-2
  End If
  If (y >= hoehe -r) Or (y <= r) Then'Ball an der Seitenlinie
    ys = -ys
    xs = xs*.9
  End If
  If Abs(xs)>br Then xs *=.95
  If Abs(xs)<1 Then xs*=2
  zeichnen
End Sub



Constructor racket
This.h=hr       'Racket-hoehe
This.b=rb           'Racket-breite
This.f=rf      'Racket-farbe
This.c=0             'Punkte
End Constructor

Sub racket.set_werte (w1 As Integer, w2 As Integer, w3 As Integer, w4 As Integer)
  'p.set_werte(halbbreit+40,hoehe,halbbreit+(glinie*3),breite-glinie)
  'c.set_werte(halbbreit-40,hoehe,halbbreit-(glinie*3)-c.b,glinie-c.b)
  x =w1  'erste Racket-position
  y =w2-h
  halb =(w2-h)\2
  xmax =w3
  xmin =w4
End Sub

Property racket.aufschlag As Integer
Aufschlag = xmin
End Property

Property racket.Punkt As Integer
Punkt = c
End Property

Property racket.Punkt(pkt As Integer) As Integer
c+=pkt
Return 0
End Property

Sub racket.loeschen
  Line(x, y)-(x+b, y+h),bg,bf 'Racket löschen
End Sub

Property racket.xpos As Single
xpos = x
End Property

Sub racket.zeichnen
  Line(x, y)-(x+b, y+h),f,bf 'Racket zeichnen
End Sub

Sub racket.Bewegungsgrenzen(pl As Integer)  'Bewegungsspielraum der Rackets eingrenzen
  If y < 5 Then y = 5
  If y > (hoehe-5-h) Then y = hoehe-5-h
  If pl=0 Then
    If x < xmin Then x = xmin
    If x > xmax Then x = xmax
  End If
  If pl=1 Then
    If x > xmin Then x = xmin
    If x < xmax Then x = xmax
  End If
End Sub

Sub racket.bewegen(dx As Single, dy As Single)
  x += Sgn(xmin-x)*dx
  y += Sgn(halb-y)*dy
End Sub

Function racket.Grundpos As Integer
  If (Sgn(xmin-x)=0) And (Sgn(halb-y)=0) Then Return 0
  loeschen
  x= Fix(x)
  y= Fix(y)
  bewegen (1,1)
  zeichnen
  Return 1
End Function



Sub Mittellinie
  Locate 1,(halbbreit\8)-2 'Punktestand anzeigen
  Print c.Punkt & "    " & p.Punkt
  Line(halbbreit,0)-(halbbreit,hoehe-1),-1,,&Hff00
End Sub

Sub auto_racket
  p.loeschen
  If b.x > (halbbreit-(p.x\6)) Then 'Racketsteuerung nach Ballposition
    p.x -= Sgn(p.x - b.x-glinie)
    p.y += Sgn(b.y-p.y-(hr\2))*vs
  Else
    p.bewegen(1,vs)
  End If
  p.Bewegungsgrenzen(1) 'Bewegungsspielraum des Rackets eingrenzen
  p.zeichnen
End Sub

Sub spieler
  c.loeschen
  If automat = 0 Then
    If b.x < (halbbreit+(c.x\5)) Then
      If b.ys<-5 Then
        c.x += Sgn(b.x-glinie-c.x)*2
      Else
        c.x += Sgn(b.x-glinie-c.x)
      End If
      c.y += Sgn(b.y-c.y-(hr\2))*vs
    Else
      c.bewegen(2,vs)
    End If
  Else
    If MultiKey(&h50) Then c.y +=vs    'runter
    If MultiKey(&h48) Then c.y -=vs    'rauf
    If MultiKey(&h4d) Then c.x +=2'vs    'vor
    If MultiKey(&h4b) Then c.x -=vs    'zurück
  End If
  c.Bewegungsgrenzen(0) 'Bewegungsspielraum des Rackets eingrenzen
  c.zeichnen
End Sub

Sub Aufschlag(player As Integer)
  If player = 0 Then
    Locate 20,(halbbreit\8)-10
    Input;"0 = Demo, 1 = Spiel "; automat
    Cls
  End If
  If player=1 Then p.Punkt(1)  'Punkt vergeben
  If player=2 Then c.Punkt(1)
  Mittellinie 'zeichnen
  b.Aufschlagposition(player)

  Dim t As Integer
  Do ' zur Grundposition zurück
    Sleep 1
    t=c.Grundpos Or p.Grundpos
    ScreenSync
    If MultiKey(1) Then Exit Sub 'ESC
  Loop While t=1
  Sleep 1000,1

End Sub

Sub aus
  Locate (hoehe\32)+1,(halbbreit\8)-10
  Print "E N D E . . ."
  Sleep 500,1
  For i As Integer = 0 To hoehe\2
    If i=hoehe\2-1 Then Sleep 1000,1
    Line (i,i)-(breite-i,hoehe-i),0,b
    ScreenSync
  Next
  Sleep 1000,1
End Sub
