Thomas Gohel (comp.lang.basic.misc)
HIGHSPEED RAYCASTING FOR PB
------------------------------------------------------------------------------

'TWO Part Snippet (RAYCAST.BAS and RAYCAST.DAT to follow)  [Requires UUDECODE]

'*************************************************************************
'
' Raycasting routines for PowerBASIC 3.2
'
' developed by Wolfgang Bruske
' new SCREEN 13 routines by Thomas Gohel
'
'*************************************************************************


$COMPILE EXE
DEFINT A-Z

MinAbstand  =  48
Winkel0   =  0
Winkel1   =  5
Winkel2   =  10
Winkel4   =  20
Winkel5   =  25
Winkel6   =  30
Winkel15  =  80
Winkel30  =  160
Winkel45  =  240
Winkel60  =  320
Winkel90  =  480
Winkel135 =  720
Winkel180 =  960
Winkel225 =  1200
Winkel270 =  1440
Winkel315 =  1680
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 Tantable(1920) as single
DIM Invtantable(1920) as single
DIM Ystep(1920) as single
DIM Xstep(1920) as single
DIM Costable(1920) as single
DIM Invcostable(1920) as single
DIM Invsintable(1920) as single
DIM Vptr as byte Ptr
DIM Maxx as integer
DIM Maxy as integer
Maxx=(WeltSpalte * ZellXgroesse)-1
Maxy=(WeltReihe * ZellYgroesse)-1

SHARED MinAbstand,Winkel0,Winkel1,Winkel2,Winkel4,Winkel5,Winkel6
SHARED Winkel15,Winkel30,Winkel45,Winkel60,Winkel90,Winkel135,Winkel180,Winkel225,Winkel270
SHARED Winkel315,Winkel360,WeltReihe,WeltSpalte,ZellXgroesse,ZellYgroesse,WeltXgroesse()
SHARED WeltYgroesse(),Welt(),tantable(),invtantable(),Ystep(),Xstep()
SHARED costable(),invcostable(),invsintable(),Sichtwinkel,Vptr,maxx,maxy

' F U N C T I O N S *******************************************************'

SUB Tabellenbauen()
DIM Winkl as integer
DIM radWinkel as ext

FOR Winkl = Winkel0  to Winkel360
    radWinkel = 3.272e-4 + Winkl * 3.27249234791667e-3
    tantable(Winkl)     = tan(radWinkel)
    invtantable(Winkl) = 1/tantable(Winkl)

    IF Winkl >= Winkel0 and Winkl < Winkel180 THEN
      Ystep(Winkl) = abs(tantable(Winkl) * ZellYgroesse)
    Else
      Ystep(Winkl) =-abs(tantable(Winkl)* ZellYgroesse)
    END IF

    IF Winkl >= Winkel90 and Winkl < Winkel270 THEN
       Xstep(Winkl) =-abs(invtantable(Winkl) * ZellXgroesse)
    Else
       Xstep(Winkl) = abs(invtantable(Winkl)  * ZellXgroesse)
    END IF

    invcostable(Winkl) = 1/cos(radWinkel)
    invsintable(Winkl) = 1/sin(radWinkel)

Next Winkl

FOR Winkl = -Winkel30 to Winkel30
    radWinkel = 3.272e-4 + Winkl * 3.27249234791667e-3
    costable(Winkl + Winkel30) = 1/cos(radWinkel)*10000
Next Winkl

END SUB

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

SUB LoadWelt(dateiname$)

DIM index as integer
DIM row as integer
DIM column as integer
DIM buffer as String
DIM ch as String
OPEN Dateiname$ FOR input as #1
FOR Row = WeltReihe to 0 step -1
    line input #1, buffer
    FOR column = 0 to WeltSpalte
        Welt(column,row) = Val(mid$(buffer,column+1,1))
    Next column
Next row
Close #1
END SUB

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

SUB RayCaster(x as long ,y as long)

DIM Oben  as single
DIM Unten as single
DIM Zellx as long
DIM Zelly as long
DIM Senke as long
DIM Waage as long
DIM ray as long
DIM xaufWaage as Single
DIM yaufSenke as Single
DIM distzuWaage as Single
DIM distzuSenke as Single
DIM Skalier as Single

resett=Sichtwinkel
Sichtwinkel=Sichtwinkel-Winkel30
IF Sichtwinkel < 0 THEN  Sichtwinkel=Winkel360 + Sichtwinkel

tempWaage= int(y/ZellYgroesse) * ZellYgroesse
tempWaage1= int(y/ZellYgroesse) * ZellYgroesse+ZellYgroesse
tempSenke= int(x/ZellXgroesse) * ZellXgroesse
tempSenke1= int(x/ZellXgroesse) * ZellXgroesse + ZellXgroesse

diffzuWaage=tempWaage-y
diffzuSenke=tempSenke-x
diffzuWaage1=tempWaage1-y
diffzuSenke1=tempSenke1-x

FOR ray = 0 to 319

    IF Sichtwinkel < Winkel180 THEN
       Waage = tempWaage1
       xaufWaage = invtantable(Sichtwinkel) * diffzuWaage1 + x
       NexteWaage=ZellYgroesse
       Nexty=0
    else
       Waage = tempWaage
       xaufWaage = invtantable(Sichtwinkel) * diffzuWaage + x
       NexteWaage=-ZellYgroesse
       Nexty=-1
    END IF

   IF Sichtwinkel < Winkel90 or Sichtwinkel >= Winkel270 THEN
       Senke = tempSenke1
       yaufSenke = tantable(Sichtwinkel) * diffzuSenke1 + y
       NexteSenke=ZellXgroesse
       Nextx=0
    else
       Senke = tempSenke
       yaufSenke = tantable(Sichtwinkel) * diffzuSenke + y
       NexteSenke=-ZellXgroesse
       Nextx=-1
    END IF


    WHILE  1

            IF xaufWaage > maxx or xaufWaage < 0 THEN
               distzuWaage = 1e+8
               exit loop
            END IF

             Zellx = int(xaufWaage/ZellXgroesse)
             Zelly = int(Waage/ZellYgroesse) + Nexty

            IF Welt(Zellx,Zelly) <> 0 THEN
               distzuWaage=(xaufWaage-x)*invcostable(Sichtwinkel)
               exit loop
            END IF

            xaufWaage = xaufWaage + Xstep(Sichtwinkel)
            Waage = Waage + NexteWaage
    WEND


    WHILE  2

            IF yaufSenke > maxy or yaufSenke < 0 THEN
               distzuSenke = 1e+8
               exit loop
            END IF

            Zellx = int(Senke/ZellYgroesse) + Nextx
            Zelly = int(yaufSenke/ZellYgroesse)

            IF Welt(Zellx,Zelly) <> 0 THEN
               distzuSenke=(yaufSenke-y)* invsintable(Sichtwinkel)
               exit loop
            END IF

            yaufSenke = yaufSenke + Ystep(Sichtwinkel)
            Senke = Senke + NexteSenke
    WEND


    IF distzuWaage < distzuSenke THEN

      Skalier = costable(ray) / distzuWaage
       Oben = 90 - Skalier/2
       IF Oben < 20 THEN Oben = 20
       Unten = 90 + Skalier/2
       IF Unten > 180 THEN Unten=180

       IF int(xaufWaage) MOD ZellYgroesse =< 1 THEN
          colorr = 15
       else
          colorr=10
       END IF
       Linie ray,20,ray,Oben ,160
       Linie ray,Oben ,ray,Unten,colorr
       Linie ray,Unten,ray,180,215
    else
       Skalier = costable(ray) / distzuSenke
       Oben = 90 - Skalier/2
       IF Oben < 20 THEN Oben = 20
       Unten = 90 + Skalier/2
       IF Unten > 180 THEN  Unten = 180
       IF int(yaufSenke) MOD ZellXgroesse = < 1 THEN
          colorr=15
       else
          colorr=2
       END IF
       Linie ray,20,ray,Oben,160
       Linie ray,Oben,ray,Unten,colorr
       Linie ray,Unten,ray,180,215
    END IF


    INCR Sichtwinkel
    IF Sichtwinkel >= Winkel360 THEN
        Sichtwinkel=0
    END IF
Next ray

Sichtwinkel=resett
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

Modus13
WriteScrn  1, 1, 11, "Raycasting Engine by Wolfgang Bruske"
WriteScrn  2, 1, 14, "SCREEN 13 Routines by Thomas Gohel"
WriteScrn 24, 1, 14, CHR$(24,25,26,27) + " oder 2, 4, 6, 8"

CALL Tabellenbauen()
CALL LoadWelt("raycast.dat")
colorr=15

x=9*64+32
y=9*64+32
Sichtwinkel=Winkel6

CALL  RayCaster(x,y)

WHILE  done = 0
     kbhit=ascii(inkey$)
     IF kbhit > 0 THEN
        Taste$=chr$(kbhit)
        kbhit = 0
        dx=0
        dy=0
        select case Taste$

               case "4"
                      DECR  Sichtwinkel,Winkel6
                      IF Sichtwinkel < Winkel0 THEN  Sichtwinkel=Winkel360+Sichtwinkel
               case "6"
                       INCR Sichtwinkel,Winkel6
                       IF Sichtwinkel > Winkel360 THEN  Sichtwinkel =Sichtwinkel-Winkel360
               case "8"
                       dx=cos(6.28*Sichtwinkel/Winkel360)*10
                       dy=sin(6.28*Sichtwinkel/Winkel360)*10
               case "2"
                       dx=-cos(6.28*Sichtwinkel/Winkel360)*10
                       dy=-sin(6.28*Sichtwinkel/Winkel360)*10

               case "q", CHR$(27)
                       Modus3
                       END
            end select
        x=x+dx
        y=y+dy

        xZell = int(x/ZellXgroesse)
        yZell = int(y/ZellYgroesse)
        xsubZell = x MOD ZellXgroesse
        ysubZell = y MOD ZellYgroesse

        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)
   END IF
WEND

SUB Modus13
        ! mov  al, &h13
        ! mov  ah, 0
        ! int  &h10
END SUB

SUB Modus3
        ! mov  al, &h03
        ! mov  ah, 0
        ! int  &h10
END SUB

SUB Linie(BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL Farbe%) public
         LOCAL s1%, s2%, s3%, s4%
         ! push es
         ! push di
         ! mov  ax, &ha000      ;' nur einmal VideoSegment setzen
         ! mov  es, ax
         ! mov  ax, x2%         ;' Differenz x2% - x1% nach ax
         ! sub  ax, x1%
         ! jns  Linie1
         ! neg  ax              ; Vorzeichentausch
Linie1:
         ! mov  bx, y2%         ; Differenz von y2% - y1% nach bx
         ! sub  bx, y1%
         ! jns  Linie2
         ! neg  bx              ; Vorzeichentausch
Linie2:
         ! cmp  ax, bx          ; Steigung <= 1 ?
         ! jge  Linie3A         ; Ja
         ! jmp  Linie20         ; Nein
Linie3A:
         ! mov  cx, x1%         ; Ist x1% <= x2% ?
         ! cmp  cx, x2%
         ! jg   Linie4
         ! mov  cx, 1           ; X steigt
         ! jmp  Linie5
Linie4:
         ! mov  cx, -1          ; X fällt
Linie5:
         ! mov  dx, y1%         ; ist y1% <= y2%
         ! cmp  dx, y2%
         ! jg   Linie6
         ! mov  dx, 1           ; Y steigt
         ! jmp  Linie7
Linie6:
         ! mov  dx, -1          ; Y fällt
Linie7:
         ! mov  s1%, cx         ; Steigung auf dem Stack speichern
         ! mov  s2%, dx
         ! add  bx, bx          ; Steigung berechnen
         ! mov  s3%, bx
         ! sub  bx, ax
         ! mov  cx, bx
         ! sub  cx, ax
         ! mov  s4%, cx
         ! mov  cx, x1%
         ! mov  dx, y1%
         ! call SetPunkt
Linie8:
         ! cmp  cx, x2%         ; Weitere Punkte?
         ! jz   Linie3
         ! add  cx, s1%         ; X-Koordinate erhöhen
         ! or   bx, bx          ; Entscheiden, ob Y-Koordinate erhöht
         ! jns  Linie10         ; wird
         ! add  bx, s3%
         ! jmp  Linie11
Linie10:
         ! add  bx, s4%         ; Nächsten Punkt ausgeben
         ! add  dx, s2%
Linie11:
         ! call Setpunkt
         ! jmp Linie8
Linie20:

';----------------------------------------------------------
'; Dieser Teil wird durchlaufen, wenn die Steigung > 1 ist
';----------------------------------------------------------

         ! mov  cx, y1%         ; Steigung ist > 1
         ! cmp  cx, y2%         ; Ist y1% <= y2% ?
         ! jg   Linie12
         ! mov  cx,1            ; Y steigt
         ! jmp  Linie13
Linie12:
         ! mov  cx, -1          ; Y fällt
Linie13:
         ! mov  dx, x1%         ; ist x1% <= x2% ?
         ! cmp  dx, x2%
         ! jg   Linie14
         ! mov  dx, 1           ; X steigt
         ! jmp  Linie15
Linie14:
         ! mov  dx, -1          ; X fällt
Linie15:
         ! mov  s1%, cx         ; Steigung auf dem Stack speichern
         ! mov  s2%, dx
         ! add  ax, ax          ; Steigung berechnen
         ! mov  s3%, ax
         ! sub  ax, bx
         ! mov  cx, ax
         ! sub  cx, bx
         ! mov  s4%, cx
         ! mov  bx, ax
         ! mov  cx, x1%
         ! mov  dx, y1%
         ! call SetPunkt
Linie16:
         ! cmp  dx, y2%         ; Weitere Punkte ausgeben?
         ! jz   Linie3
         ! add  dx, s1%
         ! or   bx, bx
         ! jns  Linie18
         ! add  bx, s3%
         ! jmp  Linie19
Linie18:
         ! add bx, s4%
         ! add cx, s2%
Linie19:
         ! call SetPunkt
         ! jmp  Linie16
Linie3:
         ! jmp Ende
SetPunkt:
         ! mov  di, dx
         ! push bx
         ! mov  bx, dx
         ! mov  ax, 320
         ! mul  bx
         ! mov  bx, cx
         ! add  bx, ax
         ! mov  al, Farbe%
         ! mov  es:[bx], al
         ! pop  bx
         ! mov  dx, di
         ! retn
Ende:
         ! pop di
         ! pop es
END SUB

SUB WriteScrn (BYVAL Zeile?, BYVAL Spalte?, BYVAL Farbe%, BYVAL Text$)
        ' PowerBASIC 3.0 kompatibel, Shit Err244 Bug :-(
        LOCAL TextSeg??, TextOff??, TextLen??
        TextSeg??   = STRSEG(Text$)
        TextOff??   = STRPTR(Text$)
        TextLen??   = LEN(Text$)
        ! push bp
        ! dec Zeile?
        ! dec Spalte?
        ! mov ax, &h1301
        ! mov bl, Farbe%
        ! mov bh, 0
        ! mov cx, TextLen??
        ! mov dh, Zeile?
        ! mov dl, Spalte?
        ! mov es, TextSeg??
        ! mov bp, TextOff??
        ! int &h10
        ! pop bp
END SUB
--- Cut End -------------------------------------------------------------

DAT-file:

--- Cut ----------------------------------------------------------------
section 1 of uuencode 5.20 of file raycast.dat    by R.E.M.

begin 644 raycast.dat
M,3$Q,3$Q,3$Q,3$Q,3$Q,0T*,2`@("`@("`@("`@("`@,0T*,2`Q(#$@,2`Q
M(#$@,2`Q,0T*,2`@("`@("`@("`@("`@,0T*,3$Q(#$Q,3$Q,3$Q("`@,0T*
M,2`@("`@,2`@("`Q("`@,0T*,2`@("`@,2`@("`Q("`@,0T*,3$Q,3$Q,2`@
M("`Q("`@,0T*,2`@("`@,3$Q(#$Q("`@,0T*,2`@("`@("`@("`Q("`@,0T*
M,2`@("`@("`@("`Q("`@,0T*,2`Q,3$Q,3$Q,3$Q,3$@,0T*,2`Q("`@("`@
M("`@("`@,0T*,2`Q("`@("`@(#$@("`@,0T*,2`@("`@("`@(#$@("`@,0T*
H,3$Q,3$Q,3$Q,3$Q,3$Q,0T*#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@H-
`
end
sum -r/size 2742/458 section (from "begin" to "end")
sum -r/size 47403/310 entire input file
--- Cut End -------------------------------------------------------------