'*************************************************************************
'                       Raycasting mit PowerBasic.
'
'Eine kleine Demonstration, wie Raycasting in PB implementiert werden kann.
'Die Demo enthaelt noch Fliesskomma-Berechnungen (langsam), verwendet eine
'langsame Bildschirmausgabe und kennt noch keinerlei Texturen (waere zu lang).
'Der Source soll zeigen wie Raycasting in Basic aussehen kann, ist aber
'ansonsten keine Meisterleistung der Basic Programmierung.
'
'Der grundlegende Algorithmus ist einem C-Source von Andre LaMothe
'entlehnt der in dem Buch "Tricks of the Game Programming Gurus"
'1994 dokumentiert worden ist (emphehlenswert!)
'
'Modifikation und Umsetzung in PowerBasic von WOLFGANG BRUSKE
'
'****************************************************************************
'****** HIER GEHTS NU LOS ***************************************************
'****************************************************************************

'Erstmal ein paar Konstanten festlegen und Globale Variablen
MinAbstand  =  48   'Abstand zu Wand

'Weil der Blickwinkel 60 Grad hat, und auf eine Bildschirm geht (320 Spalten)
'ergeben sich fuer 360 Grad 1920 Bildschirmspalten
Winkel0   =  0
Winkel6   =  30
Winkel30  =  160
Winkel90  =  480
Winkel180 =  960
Winkel270 =  1440
Winkel360 =  1920

WeltReihe =   16
WeltSpalte = 16
ZellXgroesse =  64
ZellYgroesse =  64

DIM WeltXgroesse(WeltSpalte * ZellXgroesse) as integer
DIM WeltYgroesse(WeltReihe * ZellYgroesse) as integer
DIM Welt(WeltReihe,WeltSpalte) as integer
DIM TanTabelle(1920) as single
DIM InvTanTabelle(1920) as single
DIM YSchritt(1920) as single
DIM XSchritt(1920) as single
DIM CosTabelle(1920) as single
DIM InvCosTabelle(1920) as single
DIM InvSinTabelle(1920) as single
DIM Vptr as byte Ptr
DIM MaXX as integer
DIM MaxY as integer
DIM StartX as integer
DIM StartY as integer
MaxX=(WeltSpalte * ZellXgroesse)-1
MaxY=(WeltReihe * ZellYgroesse)-1

SHARED MinAbstand,Winkel0,Winkel6,Winkel30,Winkel90,Winkel180,Winkel270
SHARED Winkel360,WeltReihe,WeltSpalte,ZellXgroesse,ZellYgroesse,WeltXgroesse()
SHARED WeltYgroesse(),Welt(),TanTabelle(),InvTanTabelle(),YSchritt(),XSchritt()
SHARED CosTabelle(),InvCosTabelle(),InvSinTabelle(),Vptr,maxX,maxy
SHARED StartX,StartY

' F U N K T I O N EN *******************************************************'

' **************************************************************************
 sub setvideo(byval Mode as integer)
 !       MOV     AH,&H00
 !       MOV     AL,Mode
 !       INT     &H010
delay 0.5
end sub
'*************************************************************************
SUB Linien(ray as long,top,bottom,Farbe)
' Naja Linien eben, eine fuer die Decke, eine fuer die Wand, und
'eine fuer den Fussboden.. spart das CLS, und flimmert nicht so.

dim i as long
Def Seg=&HA000
anfang=6400+ray
top=int(top)*320 + ray
bottom=int(bottom)*320 + ray
ende&=180*320 + ray

 for i= anfang to top step 320        'Decke
    poke i,160
 next i

 for i = top to bottom step 320         'Wand
    poke i,Farbe
 next i

 for i = bottom to Ende& step 320 'Fussboden
    poke i,213
 next i

End SUB
'*************************************************************************

SUB Tabellenbauen()   ' Wie der Name schon sagt, weils sonst zu langsam wird

DIM Winkl as integer
DIM radWinkel as ext

FOR i = Winkel0  to Winkel360
    radWinkel = 3.272e-4 + i * 3.27249234791667e-3 'Umrechnung von Grad in
                                                   'rad (Bogenmass)
    TanTabelle(i)     = tan(radWinkel)
    InvTanTabelle(i) = 1/TanTabelle(i)

    IF i >= Winkel0 and i < Winkel180 THEN
      YSchritt(i) = abs(TanTabelle(i) * ZellYgroesse)
    else
      YSchritt(i) =-abs(TanTabelle(i)* ZellYgroesse)
    END IF

    IF i >= Winkel90 and i < Winkel270 THEN
       XSchritt(i) =-abs(InvTanTabelle(i) * ZellXgroesse)
    else
       XSchritt(i) = abs(InvTanTabelle(i)  * ZellXgroesse)
    END IF

    InvCosTabelle(i) = 1/cos(radWinkel)
    InvSinTabelle(i) = 1/sin(radWinkel)

Next i

FOR i = -Winkel30 to Winkel30
    radWinkel = 3.272e-4 + i * 3.27249234791667e-3
    CosTabelle(i + Winkel30) = 1/cos(radWinkel)*12000 'hier steckt die
Next i                                         '^^^^^  Vergroesserung

END SUB

'***************************************************************************'

SUB LoadWelt() 'Liest die Datazeilen in meine "Welt" ein

DIM index as integer
DIM row as integer
DIM column as integer
DIM buffer as String
DIM ch as String
Restore Karte
FOR Row = 1 to WeltReihe
    Read buffer
    FOR column = 1 to WeltSpalte
         Welt(column,row) = Val(mid$(buffer,column,1))
         if mid$(buffer,column,1)="A" then
             StartX=(column)
             StartY=(row)
         End If
    Next column
Next row
END SUB

'***************************************************************************
' Das Kernstueck, da steckt der Gehirnschmalz drin :-)))

SUB RayCaster(X as long ,Y as long,byval Sichtwinkel)

DIM Oben  as single
DIM Unten as single
DIM ZellX as long
DIM ZellY as long
DIM Senkrechte as long
DIM Waagerechte as long
DIM ray as long
DIM XaufWaagerechte as Single
DIM YaufSenkrechte as Single
DIM distzuWaagerechte as Single
DIM distzuSenkrechte as Single
DIM Skalier as Single

Sichtwinkel=Sichtwinkel-Winkel30            'Blickrichtung -30 Grad

IF Sichtwinkel < 0 THEN  Sichtwinkel=Winkel360 + Sichtwinkel

'nur ein paar Beschleuniger ;-)

tempWaagerechte= int(Y/ZellYgroesse) * ZellYgroesse
tempWaagerechte1= int(Y/ZellYgroesse) * ZellYgroesse+ZellYgroesse
tempSenkrechte= int(X/ZellXgroesse) * ZellXgroesse
tempSenkrechte1= int(X/ZellXgroesse) * ZellXgroesse + ZellXgroesse
diffzuWaagerechte=tempWaagerechte-Y
diffzuSenkrechte=tempSenkrechte-X
diffzuWaagerechte1=tempWaagerechte1-Y
diffzuSenkrechte1=tempSenkrechte1-X

FOR ray = 0 to 319  ' nu alle 320 Bildschirmspalten durch

    IF Sichtwinkel < Winkel180 THEN          ' guck ich nach oben ? dann
       Waagerechte = tempWaagerechte1        'naechstes Kaestchen oberhalb
       XaufWaagerechte = InvTanTabelle(Sichtwinkel) * diffzuWaagerechte1 + X
       NexteWaagerechte=ZellYgroesse
       NextY=0
    else                                     'dann guck ich nach unten
       Waagerechte = tempWaagerechte         'naechstes Kaestchen unterhalb
       XaufWaagerechte = InvTanTabelle(Sichtwinkel) * diffzuWaagerechte + X
       NexteWaagerechte=-ZellYgroesse
       NextY=-1
    END IF

IF Sichtwinkel < Winkel90 or Sichtwinkel >= Winkel270 THEN ' nach rechts ?
       Senkrechte = tempSenkrechte1                         'naechstes Kaestchen rechts
       YaufSenkrechte = TanTabelle(Sichtwinkel) * diffzuSenkrechte1 + Y
       NexteSenkrechte=ZellXgroesse
       NextX=0
    else                                       'also guck ich nach links
       Senkrechte = tempSenkrechte             'naechstes Kaestchen links !
       YaufSenkrechte = TanTabelle(Sichtwinkel) * diffzuSenkrechte + Y
       NexteSenkrechte=-ZellXgroesse
       NextX=-1
    END IF


    WHILE  1  ' nu Waagerecht Kaestchen pruefen ob Wand oder Leer

            IF XaufWaagerechte > maxX or XaufWaagerechte < 0 THEN
               distzuWaagerechte = 1e+6
               exit loop
            END IF

             'zu pruefendes Kaestchen festlegen
             ZellX = int(XaufWaagerechte/ZellXgroesse)
             ZellY = int(Waagerechte/ZellYgroesse) + NextY

            IF Welt(ZellX,ZellY) <> 0 THEN ' Hurra issne Wand
               distzuWaagerechte=(XaufWaagerechte-X)*InvCosTabelle(Sichtwinkel)
               exit loop
            END IF

            'Wenn das Kaestchen leer ist, naechtes Kaestchen festlegen und nochmal
            XaufWaagerechte = XaufWaagerechte + XSchritt(Sichtwinkel)
            Waagerechte = Waagerechte + NexteWaagerechte
    WEND


    WHILE  2  'pruefen ob senkrechte Kaestchen Wand oder Leer

            IF YaufSenkrechte > maxY or YaufSenkrechte < 0 THEN
               distzuSenkrechte = 1e+8
               exit loop
            END IF

            'Naechstes Kaestchen festlegen
            ZellX = int(Senkrechte/ZellYgroesse) + NextX
            ZellY = int(YaufSenkrechte/ZellYgroesse)

            'Isse voll dann...
            IF Welt(ZellX,ZellY) <> 0 THEN
               distzuSenkrechte=(YaufSenkrechte-Y)* InvSinTabelle(Sichtwinkel)
               exit loop
            END IF

            'Isses leer dann naechstes Kaestchen das in Frage kommt...
            YaufSenkrechte = YaufSenkrechte + YSchritt(Sichtwinkel)
            Senkrechte = Senkrechte + NexteSenkrechte
    WEND


    'Nun pruefen was naeher dran ist, senkrecht oder waagerechtes Kaestchen
    'wegen der Ueberdeckung

    IF distzuWaagerechte < distzuSenkrechte THEN

     ' Wandgroesse  bestimmen
      Skalier = CosTabelle(ray) / distzuWaagerechte
       Oben = 90 - Skalier/2
       IF Oben < 20 THEN Oben = 20
       Unten = 90 + Skalier/2
       IF Unten > 180 THEN Unten=180

       'Zufaellig die Grenze zwischen zwei Kaestchen ? dann ...
       IF int(XaufWaagerechte) MOD ZellYgroesse =< 1 THEN
            Farbe = 15
       else
            Farbe=10
       END IF

       Call Linien(ray,Oben,Unten,Farbe)

    else
     ' Wandgroesse  bestimmen
       Skalier = CosTabelle(ray) / distzuSenkrechte
       Oben = 90 - Skalier/2
       IF Oben < 20 THEN Oben = 20
       Unten = 90 + Skalier/2
       IF Unten > 180 THEN  Unten = 180

       'Zufaellig die Grenze zwischen zwei Kaestchen ? dann ...
       IF int(YaufSenkrechte) MOD ZellXgroesse = < 1 THEN
            Farbe=15
       else
            Farbe=2
       END IF

       Call Linien(ray,Oben,Unten,Farbe)

    END IF

 'Nun naechste Spalte auf dem Bildschirm
    incr Sichtwinkel
    IF Sichtwinkel >= Winkel360 THEN
        Sichtwinkel=0
    END IF
Next ray

END SUB

' M A I N *****************************************************************'

DIM X as long
DIM Y as long
DIM XZell as long
DIM YZell as long
DIM XsubZell as long
DIM YsubZell as long
DIM dX as single
DIM dY as single


Call setvideo(&H13)
CALL Tabellenbauen()
CALL LoadWelt()

'Startwert fuer Spieler aus der Karte
X=(StartX*64)+32
Y=(StartY*64)+32

Sichtwinkel=Winkel6  'jede Zahl zwischen 0 und 1920 geht (1920=360Grad)

CALL  RayCaster(X,Y,Sichtwinkel)

'Steuerung =Tasten abfragen

WHILE  done = 0
     kbhit=ascii(inkey$)
     IF kbhit > 0 THEN
        Taste$=chr$(kbhit)
        kbhit = 0
        dX=0
        dY=0
         Select case Taste$

               case "4"  'will nach links drehen
                      DECR  Sichtwinkel,Winkel6
                      IF Sichtwinkel < Winkel0 THEN  Sichtwinkel=Winkel360+Sichtwinkel
               case "6"   'will nach rechts drehen
                       incr Sichtwinkel, Winkel6
                       IF Sichtwinkel > Winkel360 THEN  Sichtwinkel =Sichtwinkel-Winkel360
               case "8"   'will nach vorn
                       dX=cos(6.28*Sichtwinkel/Winkel360)*10
                       dY=sin(6.28*Sichtwinkel/Winkel360)*10
               case "2"   'will ach hinten
                       dX=-cos(6.28*Sichtwinkel/Winkel360)*10
                       dY=-sin(6.28*Sichtwinkel/Winkel360)*10

               case "q"  'Programmende
                       Call setvideo(&H03)
                       End
          End select
        X=X+dX
        Y=Y+dY

        'Die aktuelle Zelle ist ??
        XZell = int(X/ZellXgroesse)
        YZell = int(Y/ZellYgroesse)
        XsubZell = X MOD ZellXgroesse
        YsubZell = Y MOD ZellYgroesse

'testen ob ich schon in einer Wand steh, wenn ja dann ein bisschen zurueck

        IF dX > 0 THEN
           IF Welt(XZell+1,YZell) <> 0 and XsubZell > (ZellXgroesse-MinAbstand) THEN
                X = X -(XsubZell-(ZellXgroesse-MinAbstand))
           END IF
        else
           IF Welt(XZell-1,YZell) <> 0 and XsubZell < MinAbstand THEN
                X = X + (MinAbstand-XsubZell)
           END IF
         END IF

        IF dY > 0  THEN
           IF Welt(XZell,(YZell+1)) <> 0 and YsubZell > (ZellYgroesse-MinAbstand ) THEN
                Y = Y -(YsubZell-(ZellYgroesse-MinAbstand ))
           END IF
        else
           IF Welt(XZell,(YZell-1)) <> 0 and YsubZell < MinAbstand THEN
                Y = Y + (MinAbstand-YsubZell)
           END IF
        END IF
        CALL  RayCaster(X,Y,Sichtwinkel)
     END IF
WEND

'ja das wars, nu folgt nur noch die Karte

Karte:
DATA "1111111111111111"
DATA "1              1"
DATA "1  11     11   1"
DATA "1  11     11   1"
DATA "1              1"
DATA "111111  11111  1"
DATA "1    1  1      1"
DATA "1A   1  1      1"
DATA "1       1      1"
DATA "111111  1  11111"
DATA "1       1      1"
DATA "1       1      1"
DATA "111111 11      1"
DATA "1       11111  1"
DATA "1              1"
DATA "1111111111111111"

END