'****************************************************************************
'
' Program Name : RAYCAST2.BAS - Ray Casting with Texture Mapping for QB
' Developed By : Original PowerBasic Development by Wolfgang Bruske and
'                Thomas Gohel. QBASIC/QuickBasic 4.5 conversion by
'                Andrew L. Ayers.
' Date         : 04/23/97
' Comments     : I wish to thank Wolfgang Bruske and Thomas Gohel for their
'                support and advice, and especially for providing me with an
'                English translation for the PowerBasic Ray Casting clone.
'                Thomas - I am sorry none of your assembler code survived the
'                conversion - it wasn't needed due to the intrinsic routines
'                found within QB. I will say this, however: This conversion
'                doesn't come close to matching the speed and power of the
'                original PowerBasic Ray Caster. In the PB version, even the
'                texture mapping engine was done in BASIC! I had to code mine
'                in assembler in order to gain enough speed back! It presents
'                an excellent argument for moving over to PowerBasic. I plan
'                on doing so myself if I can get the funds.
'
'                Well, that is it! I hope you enjoy this program. Be sure to
'                check out the original code also!
'
'****************************************************************************
'
' Declare subroutines
'
DECLARE SUB RayCaster (ViewAngle%)
DECLARE SUB InitAsm ()
DECLARE SUB TextMap ()
DECLARE SUB VLine (y1%, y2%, colour%)
DECLARE SUB LoadTextures (file$)
DECLARE SUB TableBuild ()
DECLARE SUB CreatePalette (Filename$)
DECLARE SUB LoadWorld (Filename$)
DECLARE SUB WriteScrn (row%, column%, colour%, Text$)
'
' Define Global Variables
'
DIM SHARED Angle0%, Angle6%, Angle30%, Angle90%, Angle180%, Angle270%, ViewAngle%
DIM SHARED Angle360%, WorldRow%, WorldColumn%, CellXsize%, CellYsize%, InvCellXsize!, InvCellYsize!
DIM SHARED x%, y%, MaXX%, MaXY%
DIM SHARED StartX%, StartY%, TextureNumber%, TextureColumn%
DIM SHARED Ray%, Scale%, UpperEnd%, LowerEnd%
'
' Define global arrays
'
REDIM SHARED World%(16, 16)
REDIM SHARED Texture%(28671)
REDIM SHARED TanTable!(1920)
REDIM SHARED InvTanTable!(1920)
REDIM SHARED YStep!(1920)
REDIM SHARED XStep!(1920)
REDIM SHARED CosTable!(1920)
REDIM SHARED InvCosTable!(1920)
REDIM SHARED InvSinTable!(1920)
REDIM SHARED Code%(56)
'
MinDistance% = 32
Angle0% = 0
Angle6% = 30
Angle30% = 160
Angle90% = 480
Angle180% = 960
Angle270% = 1440
Angle360% = 1920
WorldRow% = 16
WorldColumn% = 16
CellXsize% = 64
CellYsize% = 64
'
' Initialize maximum world boundries (1024 x 1024 units)
'
MaXX% = (WorldColumn% * CellXsize%)
MaXY% = (WorldRow% * CellYsize%)
'
InvCellXsize! = 1 / CellXsize%
InvCellYsize! = 1 / CellYsize%
'
' Start *---> MAIN <---* loop
'
SCREEN 13
'
CALL InitAsm
CALL CreatePalette("TEXTURE.PAL")
'
CALL WriteScrn(1, 1, 160, "PB RayCasting Engine by Wolfgang Bruske")
CALL WriteScrn(2, 5, 120, "QB Conversion by Andrew L. Ayers")
CALL WriteScrn(24, 3, 160, "Use NumberPad to Move, [ESC] to Exit")
'
CALL LoadWorld("MAP.DAT")
CALL LoadTextures("TEXTURE.DAT")
CALL TableBuild
'
' Assign player view location (in world coordinates)
'
x% = (StartX% * 64) + 32: y% = (StartY% * 64) + 32: ViewAngle% = Angle90%
'
DO
  DX! = 0: DY! = 0
  '
  ' Draw the world!
  '
  CALL RayCaster(ViewAngle%)
  '
  ' Get user input
  '
  DO: key$ = INKEY$: LOOP UNTIL key$ <> ""
  '
  SELECT CASE key$
    CASE "4"
      '
      ' Rotating left
      '
      ViewAngle% = ViewAngle% - Angle6%
      IF ViewAngle% < Angle0% THEN ViewAngle% = Angle360% + ViewAngle%
    CASE "6"
      '
      ' Rotating right
      '
      ViewAngle% = ViewAngle% + Angle6%
      IF ViewAngle% > Angle360% THEN ViewAngle% = ViewAngle% - Angle360%
    CASE "8"
      '
      ' Moving forward
      '
      DX! = COS(6.28 * ViewAngle% / Angle360%) * 15
      DY! = SIN(6.28 * ViewAngle% / Angle360%) * 15
    CASE "2"
      '
      ' Moving backward
      '
      DX! = -(COS(6.28 * ViewAngle% / Angle360%) * 15)
      DY! = -(SIN(6.28 * ViewAngle% / Angle360%) * 15)
    CASE CHR$(27)
      '
      ' Player has quit - exit
      '
      SCREEN 0: WIDTH 80: CLS : EXIT DO
  END SELECT
  '
  ' Move the player
  '
  x% = x% + DX!
  y% = y% + DY!
  '
  ' Do collision detection with walls
  '
  XCell% = INT(x% / CellXsize%)
  YCell% = INT(y% / CellYsize%)
  XSubCell% = x% AND CellXsize% - 1
  YSubCell% = y% AND CellYsize% - 1
  '
  IF DX! > 0 THEN
    IF World%(XCell% + 1, YCell%) <> 0 AND XSubCell% > (CellXsize% - MinDistance%) THEN
      x% = x% - (XSubCell% - (CellXsize% - MinDistance%))
    END IF
  ELSE
    IF World%(XCell% - 1, YCell%) <> 0 AND XSubCell% < MinDistance% THEN
      x% = x% + (MinDistance% - XSubCell%)
    END IF
  END IF
  '
  IF DY! > 0 THEN
    IF World%(XCell%, (YCell% + 1)) <> 0 AND YSubCell% > (CellYsize% - MinDistance%) THEN
      y% = y% - (YSubCell% - (CellYsize% - MinDistance%))
    END IF
  ELSE
    IF World%(XCell%, (YCell% - 1)) <> 0 AND YSubCell% < MinDistance% THEN
      y% = y% + (MinDistance% - YSubCell%)
    END IF
  END IF
  '
LOOP
'
' Deallocate global arrays
'
REDIM SHARED World%(0, 0)
REDIM SHARED Texture%(0)
REDIM SHARED TanTable!(0)
REDIM SHARED InvTanTable!(0)
REDIM SHARED YStep!(0)
REDIM SHARED XStep!(0)
REDIM SHARED CosTable!(0)
REDIM SHARED InvCosTable!(0)
REDIM SHARED InvSinTable!(0)
REDIM SHARED Code%(0)
'
END

SUB CreatePalette (Filename$)
  '
  ' Load palette data
  '
  inputt$ = SPACE$(768)
  palmask% = &H3C6
  palreg% = &H3C8
  paldata% = &H3C9
  '
  OPEN Filename$ FOR BINARY AS #1
  '
  GET #1, , inputt$
  '
  CLOSE #1
  '
  FOR I% = 1 TO 768 STEP 3
    OUT palmask%, &HFF
    OUT palreg%, count%
    OUT paldata%, ASC(MID$(inputt$, I%, 1))
    OUT paldata%, ASC(MID$(inputt$, I% + 1, 1))
    OUT paldata%, ASC(MID$(inputt$, I% + 2, 1))
    count% = count% + 1
  NEXT
  '
END SUB

SUB InitAsm
  '
  ' Initialize Texture Mapping (TEXTMAP1.ASM) Assembler Routine
  '
  Code$ = "1E5589E58B760CB106D3E689F3B102D3E601DE8B5E0E01DE8B5E1801DE8B4612"
  Code$ = Code$ + "BB0010F7E389C38B7E10B106D3E701DF037E1483EF0731DB8B4E0C83F914"
  Code$ = Code$ + "7C1481F9B4007F0E8B46168ED88A158B461A8ED8881483C3403B5E087E0647"
  Code$ = Code$ + "2B5E08EBF581C64001413B4E0A7ECF5D1FCA1400"
  '
  DEF SEG = VARSEG(Code%(0))
  '
  FOR I% = 0 TO 112
    d% = VAL("&h" + MID$(Code$, I% * 2 + 1, 2))
    POKE VARPTR(Code%(0)) + I%, d%
  NEXT I%
  '
  DEF SEG
  '
END SUB

SUB LoadTextures (file$)
  '
  ' Load in texture maps
  '
  DEF SEG = VARSEG(Texture%(0))
  BLOAD file$, 0
  DEF SEG
  '
END SUB

SUB LoadWorld (Filename$)
  '
  ' Read in World Data Map
  '
  OPEN Filename$ FOR INPUT AS #1
  '
  FOR row% = 1 TO WorldRow%
    '
    LINE INPUT #1, Buffer$
    '
    FOR column% = 1 TO WorldColumn%
      '
      World%(column%, row%) = VAL(MID$(Buffer$, column%, 1))
      '
      IF MID$(Buffer$, column%, 1) = "A" THEN
	'
	' Set player starting location
	'
	StartX% = column%
	StartY% = row%
      END IF
      '
    NEXT
    '
  NEXT
  '
  CLOSE #1
  '
END SUB

SUB RayCaster (ViewAngle%)
  '
  ' Raycasting Routine - First define some local variables
  '
  DIM CellX%
  DIM CellY%
  DIM XonHorizontal AS SINGLE
  DIM YonVertical AS SINGLE
  DIM DistTOHorizontal AS SINGLE
  DIM DistTOVertical AS SINGLE
  '
  ' Define start sweep angle (View angle - 30 degrees)
  '
  VAngle% = ViewAngle% - Angle30%
  IF VAngle% < 0 THEN VAngle% = Angle360% + VAngle%
  '
  ' Find first horizontal grid lines
  '
  TempHorizontal% = INT(y% / CellYsize%) * CellYsize%
  TempHorizontal1% = INT(y% / CellYsize%) * CellYsize% + CellYsize%
  '
  ' Find first vertical grid lines
  '
  TempVertical% = INT(x% / CellXsize%) * CellXsize%
  TempVertical1% = INT(x% / CellXsize%) * CellXsize% + CellXsize%
  '
  ' Find distance to both horizontal grid lines
  '
  DiffTOHorizontal% = TempHorizontal% - y%
  DiffTOHorizontal1% = TempHorizontal1% - y%
  '
  ' Find distance to both vertical grid lines
  '
  DiffTOVertical% = TempVertical% - x%
  DiffTOVertical1% = TempVertical1% - x%
  '
  ' Cast out 320 rays (one for each vertical screen line)
  '
  FOR Ray% = 0 TO 319
    '
    ' Find horizontal/vertical intercepts based on which quadrant of a unit
    ' circle the ray is in...
    '
    IF VAngle% < Angle180% THEN
      Horizontal% = TempHorizontal1%
      XonHorizontal = InvTanTable!(VAngle%) * DiffTOHorizontal1% + x%
      NextHorizontal% = CellYsize%
      NextY% = 0
    ELSE
      Horizontal% = TempHorizontal%
      XonHorizontal = InvTanTable!(VAngle%) * DiffTOHorizontal% + x%
      NextHorizontal% = -CellYsize%
      NextY% = -1
    END IF
    '
    IF VAngle% < Angle90% OR VAngle% >= Angle270% THEN
      Vertical% = TempVertical1%
      YonVertical = TanTable!(VAngle%) * DiffTOVertical1% + y%
      NextVertical% = CellXsize%
      NextX% = 0
    ELSE
      Vertical% = TempVertical%
      YonVertical = TanTable!(VAngle%) * DiffTOVertical% + y%
      NextVertical% = -CellXsize%
      NextX% = -1
    END IF
    '
    ' Step thru horizontal intercepts until a wall is hit, or ray escapes
    '
    DO
      IF XonHorizontal > MaXX% OR XonHorizontal < 0 THEN
	DistTOHorizontal = 1000000!
	EXIT DO
      END IF
      CellX% = INT(XonHorizontal * InvCellXsize!)
      CellY% = INT(Horizontal% * InvCellYsize!) + NextY%
      IF World%(CellX%, CellY%) THEN
	DistTOHorizontal = (XonHorizontal - x%) * InvCosTable!(VAngle%)
	TextureNumberHorz% = World%(CellX%, CellY%)
	EXIT DO
      END IF
      XonHorizontal = XonHorizontal + XStep!(VAngle%)
      Horizontal% = Horizontal% + NextHorizontal%
    LOOP
    '
    ' Step thru vertical intercepts until a wall is hit, or ray escapes
    '
    DO
      IF YonVertical > MaXY% OR YonVertical < 0 THEN
	DistTOVertical = 1000000!
	EXIT DO
      END IF
      CellX% = INT(Vertical% * InvCellXsize!) + NextX%
      CellY% = INT(YonVertical * InvCellYsize!)
      IF World%(CellX%, CellY%) THEN
	TextureNumberVert% = World%(CellX%, CellY%) + 6
	DistTOVertical = (YonVertical - y%) * InvSinTable!(VAngle%)
	EXIT DO
      END IF
      YonVertical = YonVertical + YStep!(VAngle%)
      Vertical% = Vertical% + NextVertical%
    LOOP
    '
    ' Draw using closest intercept only
    '
    IF DistTOHorizontal < DistTOVertical THEN
      '
      ' Find correct texture strip scale
      '
      TextureNumber% = TextureNumberHorz%
      TextureColumn% = INT(XonHorizontal) MOD CellYsize%
      Scale% = CosTable!(Ray%) / DistTOHorizontal
      Scale% = Scale% - Scale% MOD 2
      '
      UpperEnd% = 100 - (Scale% \ 2)
      LowerEnd% = UpperEnd% + Scale%
      '
      ' Draw ceiling strip
      '
      IF UpperEnd% > 20 THEN CALL VLine(20, UpperEnd%, 36)
      '
      ' Draw wall strip
      '
      CALL TextMap
      '
      ' Draw floor strip
      '
      IF LowerEnd% < 180 THEN CALL VLine(LowerEnd%, 180, 215)
    ELSE
      '
      ' Find correct texture strip scale
      '
      TextureNumber% = TextureNumberVert%
      TextureColumn% = INT(YonVertical) MOD CellXsize%
      Scale% = CosTable!(Ray%) / DistTOVertical
      Scale% = Scale% - Scale% MOD 2
      '
      UpperEnd% = 100 - (Scale% \ 2)
      LowerEnd% = UpperEnd% + Scale%
      '
      ' Draw ceiling strip
      '
      IF UpperEnd% > 20 THEN CALL VLine(20, UpperEnd%, 36)
      '
      ' Draw wall strip
      '
      CALL TextMap
      '
      ' Draw floor strip
      '
      IF LowerEnd% < 180 THEN CALL VLine(LowerEnd%, 180, 215)
    END IF
    '
    ' Next angle for ray
    '
    VAngle% = VAngle% + 1
    '
    IF VAngle% >= Angle360% THEN VAngle% = 0
    '
  NEXT
  '
END SUB

SUB TableBuild
  '
  ' Precalculate global trig tables for later use to speed up processing
  '
  CALL WriteScrn(12, 3, 161, "Please Wait - Building Trig Tables...")
  '
  DIM RadAngle AS DOUBLE
  '
  FOR I% = Angle0% TO Angle360%
    '
    RadAngle = .0003272 + I% * 3.27249234791667D-03
    '
    TanTable!(I%) = TAN(RadAngle)
    '
    InvTanTable!(I%) = 1 / TanTable!(I%)
    '
    IF I% >= Angle0% AND I% < Angle180% THEN
      YStep!(I%) = ABS(TanTable!(I%) * CellYsize%)
    ELSE
      YStep!(I%) = -ABS(TanTable!(I%) * CellYsize%)
    END IF
    '
    IF I% >= Angle90% AND I% < Angle270% THEN
      XStep!(I%) = -ABS(InvTanTable!(I%) * CellXsize%)
    ELSE
      XStep!(I%) = ABS(InvTanTable!(I%) * CellXsize%)
    END IF
    '
    InvCosTable!(I%) = 1 / COS(RadAngle)
    InvSinTable!(I%) = 1 / SIN(RadAngle)
    '
  NEXT
  '
  FOR I% = -Angle30% TO Angle30%
    RadAngle = .0003272 + I% * 3.27249234791667D-03
    CosTable!(I% + Angle30%) = 1 / COS(RadAngle) * 12000
  NEXT
  '
END SUB

SUB TextMap
  '
  ' Call assembly raycasting routine
  '
  DEF SEG = VARSEG(Code%(0))
  '
  CALL ABSOLUTE(BYVAL &HA000, BYVAL 0, BYVAL VARSEG(Texture%(0)), BYVAL VARPTR(Texture%(0)), BYVAL TextureNumber% - 1, BYVAL TextureColumn%, BYVAL Ray%, BYVAL UpperEnd%, BYVAL LowerEnd%, BYVAL Scale%, VARPTR(Code%(0)))
  '
  DEF SEG
  '
END SUB

SUB VLine (y1%, y2%, col%)
  '
  ' Draw a vertical line using endpoints, ray number, and color
  '
  LINE (Ray%, y1%)-(Ray%, y2%), col%
  '
END SUB

SUB WriteScrn (row%, column%, colour%, Text$)
  '
  ' Write a string using color specified on screen
  '
  COLOR colour%: LOCATE row%, column%: PRINT Text$;
  '
END SUB

