'#############################
'###                       ###
'###  M i k r o - P o n g  ###
'###       (c)  2009       ###
'###          von          ###
'###     Thomas Krüger     ###
'###                       ###
'#############################

$regfile "m8def.dat"
$crystal = 1000000


'### Variablendefination für Displaysteuerung
Dim Dispram(5) As Byte
Dim Dispcol As Byte
Dim Dispcnt As Byte
Dim X As Byte
Dim Y As Byte
Dim Ys As Byte
Dim Yy As Byte

'### Variablendefination für das Spiel
Dim Level As Byte
Dim Ballwait As Word
Dim Levelticks As Word
Dim Cur As Byte
Dim Xb As Byte
Dim Yb As Byte
Dim Rx As Byte
Dim Ry As Byte
Dim Game_end As Boolean
Dim Level_end As Boolean


'### Konfiguration für Display
Config Portd = Output
Config Portc = Output

Dispcol = 1 : Dispcnt = 1


'### Konfiguration der Taster
Config Portb.0 = Output
Config Portb.1 = Output

Portb.0 = 1 : Portb.1 = 1


'### Timersteuerung für Multiplexansteuerung konfigurieren
Config Timer0 = Timer , Prescale = 8
Enable Timer0
On Timer0 Refresh_display

Config Timer1 = Timer , Prescale = 1
On Timer1 Change_ball

Enable Interrupts


'### Start des Spiels
Start_game:
  Gosub Mtx_cls : Ys = 0 : Level = 1 : Ballwait = 1000
Run_text:
  For Y = 1 To 5
    Yy = Ys + Y : Dispram(y) = Lookup(yy , Title_data)
  Next Y : Waitms 100
  Incr Ys : If Ys = 30 Then Ys = 0
  If Pinb.0 = 0 Then Goto Exit_title
  If Pinb.1 = 0 Then Goto Exit_title
  Goto Run_text
Exit_title:
  Gosub Waitkeypressed


'### Nächsten Level vorbereiten
Next_level:
  For X = 1 To 5
    Yy = Level - 1 : Yy = Yy * 5 : Yy = Yy + X : Decr Yy
    Dispram(x) = Lookup(yy , Level_char_data)
  Next X : Gosub Waitkeypressed
  Gosub Mtx_cls
  Cur = 2 : Gosub Draw_paddle
  Xb = 4 : Yb = 2 : Game_end = 0 : Rx = 1
  If Rnd(1) = 1 Then Ry = 0 Else Ry = 1
  Enable Timer1
  Level_end = 0 : Levelticks = 10 - Level


'### Hauptprogramm
Game_loop:
  If Pinb.0 = 0 Then
    Gosub Del_paddle
    Decr Cur : If Cur = 0 Then Cur = 1
    Gosub Draw_paddle : Waitms 100
  End If
  If Pinb.1 = 0 Then
    Gosub Del_paddle
    Incr Cur : If Cur = 7 Then Cur = 6
    Gosub Draw_paddle : Waitms 100
  End If
  If Game_end = 1 Then
    Disable Timer1 : Waitms 3000
    Goto Game_over
  End If
  If Level_end = 1 Then
    Disable Timer1 : Incr Level
    If Level = 10 Then Goto Game_won Else Goto Next_level
  End If
  Goto Game_loop


'### Spiel beendet
Game_over:
  Gosub Mtx_cls
  Dispram(1) = &B01000000
  Dispram(2) = &B00100010
  Dispram(3) = &B00101000
  Dispram(4) = &B00100010
  Dispram(5) = &B01000000
  Gosub Waitkeypressed : Goto Start_game


'### Spiel gewonnen
Game_won:
  Gosub Mtx_cls
  Dispram(1) = &B00010000
  Dispram(2) = &B00100010
  Dispram(3) = &B00101000
  Dispram(4) = &B00100010
  Dispram(5) = &B00010000
  Gosub Waitkeypressed : Goto Start_game


'### Routine: Schläger löschen
Del_paddle:
  Disable Interrupts
  Y = Cur : X = 5 : Gosub Mtx_preset : Y = Cur + 1 : Gosub Mtx_preset
  Enable Interrupts
Return


'### Routine: Schläger zeichnen
Draw_paddle:
  Disable Interrupts
  Y = Cur : X = 5 : Gosub Mtx_pset : Y = Cur + 1 : Gosub Mtx_pset
  Enable Interrupts
Return


'### Routine: Ballsteuerung
Change_ball:
  Decr Ballwait : If Ballwait = 0 Then
    Level_end = 1 : Ballwait = 1000 : Goto Change_ball_exit
  End If
  Decr Levelticks : If Levelticks <> 0 Then Goto Change_ball_exit
  Levelticks = 10 - Level
  X = Xb : Y = Yb : Gosub Mtx_preset
  If Xb = 1 Then
    Rx = 0 : If Rnd(255) < 63 Then
      If Ry = 1 Then Ry = 0 Else Ry = 1
    End If
    If Rnd(255) < 31 Then Ry = 2
  End If
  If Xb = 4 Then
    Rx = 1 : If Rnd(255) < 63 Then
      If Ry = 1 Then Ry = 0 Else Ry = 1
    End If
    If Rnd(255) < 31 Then Ry = 2
  End If
  If Yb = 1 Then
    Ry = 0 : If Rnd(255) < 63 Then
      If Rx = 1 Then Rx = 0 Else Rx = 1
    End If
    If Rnd(255) < 31 Then Rx = 2
  End If
  If Yb = 7 Then
    Ry = 1 : If Rnd(255) < 63 Then
      If Rx = 1 Then Rx = 0 Else Rx = 1
    End If
    If Rnd(255) < 31 Then Rx = 2
  End If
  Select Case Rx
    Case 0 : Incr Xb
    Case 1 : Decr Xb
  End Select
  Select Case Ry
    Case 0 : Incr Yb
    Case 1 : Decr Yb
  End Select
  X = Xb : Y = Yb : Gosub Mtx_pset
  If Xb = 4 Then
    Yy = Cur + 1
    If Yb = Cur Then
      Game_end = 0 : Goto Change_ball_exit
    End If
    If Yb = Yy Then
      Game_end = 0 : Goto Change_ball_exit
    End If
    Game_end = 1
  End If
Change_ball_exit:
Return


'### Routine: Auf Tastendruck warten
Waitkeypressed:
  If Pinb.0 = 0 Then Goto Waitkeypressed_exit
  If Pinb.1 = 0 Then Goto Waitkeypressed_exit
  Goto Waitkeypressed
Waitkeypressed_exit:
  While Pinb.0 = 0 : Wend : While Pinb.1 = 0 : Wend
Return


'### Routine: Display löschen
Mtx_cls:
  For Yy = 1 To 5
    Dispram(yy) = 0
  Next Yy
Return


'### Routine: Pixel setzen
Mtx_pset:
  Yy = Y -1 : Ys = 2 ^ Yy
  Dispram(x) = Dispram(x) Or Ys
Return


'### Routine: Pixel löschen
Mtx_preset:
  Yy = Y -1 : Ys = 2 ^ Yy : Ys = Not Ys
  Dispram(x) = Dispram(x) And Ys
Return


'### Interrupt-Routine: Multiplexsteuerung des Displays
Refresh_display:
  Portc = Dispcol : Portd = Dispram(dispcnt)
  Incr Dispcnt : If Dispcnt = 6 Then Dispcnt = 1
  Shift Dispcol , Left : If Dispcol = 32 Then Dispcol = 1
Return


'### Daten für Titel-Laufschrift
Title_data:
  Data &B00000000 , &B00000000 , &B00000000 , &B00000000 , &B00000000 , &B00000000
  Data &B01111111 , &B00001001 , &B00001001 , &B00001001 , &B00000110 , &B00000000
  Data &B00111110 , &B01000001 , &B01000001 , &B01000001 , &B00111110 , &B00000000
  Data &B01111111 , &B00000100 , &B00001000 , &B00010000 , &B01111111 , &B00000000
  Data &B00111110 , &B01000001 , &B01001001 , &B01001001 , &B01111001 , &B00000000
  Data &B00000000 , &B00000000 , &B00000000 , &B00000000 , &B00000000 , &B00000000


'### Daten für Level-Anzeigen
Level_char_data:
  Data &B00000000 , &B00100100 , &B00111110 , &B00100000 , &B00000000
  Data &B00000000 , &B00111010 , &B00101010 , &B00101110 , &B00000000
  Data &B00000000 , &B00100010 , &B00101010 , &B00010100 , &B00000000
  Data &B00000000 , &B00001110 , &B00001000 , &B00111110 , &B00000000
  Data &B00000000 , &B00101110 , &B00101010 , &B00111010 , &B00000000
  Data &B00000000 , &B00111110 , &B00101010 , &B00111010 , &B00000000
  Data &B00000000 , &B00000010 , &B00111010 , &B00000110 , &B00000000
  Data &B00000000 , &B00111110 , &B00101010 , &B00111110 , &B00000000
  Data &B00000000 , &B00101110 , &B00101010 , &B00111110 , &B00000000