'===========================================================================
' Subject: DOOMED V3.2 (RAYTRACER)           Date: 09-05-97 (20:15)       
' Author:  Sami Kyostila                     Code: QB, QBasic, PDS        
' Origin:  hiteck@mail.freenet.hut.fi      Packet: GRAPHICS.ABC
'===========================================================================
'-------------------------------------------------------------------
'               DooMed Raytracer v3.2 for QBasic
'
'                by   S A M i   K Y ™ S T i L Ž
'  
'   
'                           1 9 9 7
'     
'
' Well, I finally finished my first raytracer. It's still has some bugs,
' but it works! And it's quite fast also (around 30 fps on my Cx6x86 P150+)
' This is the only QBasic raytracer I've seen with distance shading and
' a map mode. Special thanks to Peter Cooper for his DOOM RayCaster
' (modified by A LOT of people), it helped me to get the basic idea behind
' raytracers.
'
' If You have any questions, comments, bugfixes, etc. please mail them to:
'
'   hiteck@freenet.hut.fi
'
' or:
'
'   kemple.oy@mbnet.fi
'
' or contact hiteck in IRC
'
'
' You may use this code freely, as long as the original author is credited.
'
'-------------------------------------------------------------------



'-------------------------------------------------------------------
'                           Known bugs
'-------------------------------------------------------------------
'
'  - Texture-engine sometimes shows a large block in the middle of
'    the screen.
'  - Sprite-engine has some alignment problems.
'  - If the Viewwidth-constant is changed, sometimes the screen won't
'    center properly and will have alignment problems. 40 or 30 works fine.
'    (or even 100, if you want a bug-eyed effect ;)
'  - Different screen sizes may cause screen alignment errors.
'
'-------------------------------------------------------------------


'-------------------------------------------------------------------
'                          Revision history
'-------------------------------------------------------------------
'
'v1.0
'====
'
' The first and the slowest version of them all. Still used screenmode 7.
' Around 0.5 fps, with textures 0.1 fps
'
'v2.0
'====
'
' Rewrote the whole engine, but now it's a Doom-style thingy, with polygonal
' sectors. Actually this is now a separate project, since it's completely
' different from the other versions.
'
'
'v3.0
'====
'
' Rewrote the whole engine again. Now it uses screenmode 13 with distance
' shading. Added all the tables, so no floating point calculation was used
' during rendering process. Had a simple map mode. Also had texture- and
' sprite-engines.
'
'
'v3.1
'====
'
' Added even more lookup tables for speed. Rewrote map mode and keyboard
' handler. Added Intro screen. Added compass. Added framecounter
'
'v3.2
'====
'
' Added distance shading to map mode. Added Exit screen and error handler.
' Optimized speed. Fixed most of texture-engine's bugs. Added a color
' lookup table. Fixed some alignment bugs with map mode. Added strafe
' and run keys. Runs at a playable speed. Fixed some sprite-engine
' bugs.
'
'-------------------------------------------------------------------

DECLARE SUB ShowExit ()
DECLARE SUB Update ()
DECLARE SUB DrawScreen ()
DECLARE SUB Smooth (xpos&, YPos&, XLen%, YLen%, Times!, Rate!, Lowest!)
DECLARE SUB DrawMap ()
DECLARE SUB ShowIntro ()
DECLARE SUB Center (Text$)
DECLARE FUNCTION Trim$ (Number!)
DECLARE FUNCTION Error$ (Virhe!)


DEFLNG D, X-Y
ON ERROR GOTO ErrorHandler




CONST Pi = 22 / 7        'PI  (close enough)
CONST LevelXLen = 20     'Level X Lenght
CONST LevelYLen = 20     'Level Y Lenght
CONST ScreenXLen = 240   'Screen X Lenght
CONST ScreenYLen = 140   'Screen Y Lenght
CONST Viewwidth = 40     'Player's view width in degrees
CONST Turnrate = 6       'How fast the player will turn (degrees)
CONST Textures = 0       'Draw Textures (1: on, 0: off)
CONST WalkSpeed = 200    'Player's walkingspeed
CONST Sprites = 0        'Draw Sprites (1: on, 0: off)
CONST SkyColor = 1       'Color of sky
CONST FloorColor = 0     'Color if floor
CONST Darkness = 1       'Darkness level (higher = darker)
CONST Framerate = 1      'Display Framerate (1:yes, 0:no)

CONST UpArrow% = 72, DnArrow% = 80, LArrow% = 75, RArrow% = 77, Esc% = 1 'Keys
CONST Alt% = 56, Shift% = 42


DIM SHARED Level(LevelXLen - 1, LevelYLen - 1) AS LONG   'Leveldata
DIM SHARED Visible&(LevelXLen - 1, LevelYLen - 1)
DIM SHARED Shade&(LevelXLen - 1, LevelYLen - 1)
DIM SHARED OrgShade&(LevelXLen - 1, LevelYLen - 1)
DIM SHARED Sine(-Viewwidth TO 360 + Viewwidth)           'Sinetable
DIM SHARED Cosine(-Viewwidth TO 360 + Viewwidth)         'Cosinetable
DIM SHARED Px&, Py&, Pa&                                 'Player coords. and view angle
DIM SHARED Tx&, Ty&, Sprite                              'Texture and sprite coords.
DIM SHARED SpriteX&(20)                                  'Sprite coords.
DIM SHARED SpriteDist&(20)
DIM SHARED SpriteMapX&(20)
DIM SHARED SpriteMapY&(20)
DIM SHARED Spritecount&(20)
DIM SHARED Sprite&
DIM SHARED Message$                                      'Message displayed on screen
DIM SHARED Dist&(300)                                    'Distance table
DIM SHARED Dist2&(300)                                   '-
DIM SHARED ScreenStep
DIM SHARED YStart&
DIM SHARED MapMode, Change
DIM SHARED Frame&, Start&
DIM SHARED Strafe&, Fast&
DIM SHARED Colr&(16, 300)

RESTORE Texture
READ Tx&, Ty&
DIM SHARED Texture(Tx& - 1, Ty& - 1)
ScreenStep = ScreenXLen / (Viewwidth) \ 2
YStart& = 100 - ScreenYLen \ 2
DIM SHARED BufferDist&(ScreenXLen / ScreenStep)          'Buffer 1
DIM SHARED BufferCol&(ScreenXLen / ScreenStep)           'Buffer 2



Message$ = "DOOMED v3.2 BY SAMI KY™STILŽ"
MapMode = -1

ShowIntro
SCREEN 13: CLS


'-------------------------------------------------------------------
'                       Read Palette
'-------------------------------------------------------------------

RESTORE Pal

FOR i = 0 TO 255
  READ red, green, blue
  OUT (&H3C8), i
  OUT (&H3C9), red
  OUT (&H3C9), green
  OUT (&H3C9), blue
NEXT

          



'-------------------------------------------------------------------
'                       Draw border and text
'-------------------------------------------------------------------

FOR xx& = 0 TO 20
  LINE (xx& + 19, xx& + 9)-(319 - xx& - 19, 199 - xx& - 9), (xx& + (14 * 16)) \ 2, BF
NEXT

DEF SEG = &HA000

LINE (7 * 8 - 2, 22 * 8 - 3)-(8 * LEN(Message$) + 7 * 8 + 2, 22 * 8 + 8 + 1), TextCol * 15, BF
TextCol = 12
LOCATE 23, 8: PRINT Message$
FOR y = 22 * 8 - 2 TO 22 * 8 + 8
  FOR x = 7 * 8 - 1 TO 7 * 8 + LEN(Message$) * 8 + 1
    IF PEEK(y * 320 + x) = 0 THEN POKE (y * 320 + x), (TextCol - 1) * 16 ELSE POKE (y * 320 + x), TextCol * 16
  NEXT
NEXT
Smooth 7 * 8, 22 * 8 - 1, 8 * LEN(Message$), 8, 1, 1, (TextCol - 1) * 16
LINE (7 * 8 - 2, 22 * 8 - 3)-(8 * LEN(Message$) + 7 * 8 + 2, 22 * 8 + 8 + 1), TextCol * 15, B

'-------------------------------------------------------------------
'               Initialize player position and angle
'-------------------------------------------------------------------
Px& = 1351
Py& = 1605
Pa& = 360
Update                  'Calculate & Draw Screen
DrawScreen

'-------------------------------------------------------------------
'                       Draw compass
'-------------------------------------------------------------------
CIRCLE (20, 179), 20, 8
PAINT (20, 179), 8, 8
CIRCLE (20, 179), 19, 7
PAINT (20, 179), 7, 7
CIRCLE (20, 179), 18, 15
PAINT (20, 179), 15, 15
CIRCLE (20, 179), 17, 7
PAINT (20, 179), 7, 7
CIRCLE (20, 179), 16, 8
PAINT (20, 179), 0, 8

'///////////////////////////////////////////////////////////////////
'\\\\\\\\\\\\\\\\\\\\\\\Start main loop\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'///////////////////////////////////////////////////////////////////

DO
'-------------------------------------------------------------------
'                       Draw heading
'-------------------------------------------------------------------
IF OldPa& <> Pa& THEN LINE (20, 179)-(20 + Sine((OldPa& + 360) MOD 360) * 10, 179 + Cosine((OldPa& + 360) MOD 360) * 10), 0
LINE (20, 179)-(20 + Sine((Pa& + 360) MOD 360) * 10, 179 + Cosine((Pa& + 360) MOD 360) * 10), 14

OldPa& = Pa&
OldPy& = Py&
OldPx& = Px&
turn = 0

'-------------------------------------------------------------------
'                      Handle keypresses
'-------------------------------------------------------------------

Getkey:
DO
Keycode% = INP(&H60)
IF MapMode = -1 THEN DrawScreen
LOOP UNTIL Keycode%

DO WHILE LEN(INKEY$): LOOP


SELECT CASE Keycode%
  CASE RArrow
    Dummy% = INP(&H60)
    IF Strafe& = 0 THEN
      IF Fast& = 0 THEN
        Pa& = Pa& - Turnrate: turn = 1
      ELSE
        Pa& = Pa& - Turnrate * 2: turn = 1
      END IF
    ELSE
      IF Fast& = 0 THEN
        Px& = Px& + Sine((Pa& + 90) MOD 360) * -WalkSpeed
        Py& = Py& + Cosine((Pa& + 90) MOD 360) * -WalkSpeed
      ELSE
        Px& = Px& + Sine((Pa& + 90) MOD 360) * (-WalkSpeed * 2)
        Py& = Py& + Cosine((Pa& + 90) MOD 360) * (-WalkSpeed * 2)
      END IF
    END IF
  CASE LArrow
    Dummy% = INP(&H60)
    IF Strafe& = 0 THEN
      IF Fast& = 0 THEN
        Pa& = Pa& + Turnrate: turn = 1
      ELSE
        Pa& = Pa& + Turnrate * 2: turn = 1
      END IF
    ELSE
      IF Fast& = 0 THEN
        Px& = Px& + Sine((Pa& + 90) MOD 360) * WalkSpeed
        Py& = Py& + Cosine((Pa& + 90) MOD 360) * WalkSpeed
      ELSE
        Px& = Px& + Sine((Pa& + 90) MOD 360) * (WalkSpeed * 2)
        Py& = Py& + Cosine((Pa& + 90) MOD 360) * (WalkSpeed * 2)
      END IF
    END IF
    
  CASE UpArrow
    Dummy% = INP(&H60)
    IF Fast& = 0 THEN
      Px& = Px& + Sine(Pa&) * WalkSpeed
      Py& = Py& + Cosine(Pa&) * WalkSpeed
    ELSE
      Px& = Px& + Sine(Pa&) * (WalkSpeed * 2)
      Py& = Py& + Cosine(Pa&) * (WalkSpeed * 2)
    END IF


  CASE DnArrow
    Dummy% = INP(&H60)
    IF Fast& = 0 THEN
      Px& = Px& + Sine(Pa&) * -WalkSpeed
      Py& = Py& + Cosine(Pa&) * -WalkSpeed
    ELSE
      Px& = Px& + Sine(Pa&) * (-WalkSpeed * 2)
      Py& = Py& + Cosine(Pa&) * (-WalkSpeed * 2)
    END IF

  CASE Esc: EXIT DO

  CASE 15 AND TIMER > Change + .2
    Change = TIMER
    MapMode = -MapMode
    xx& = ((160 - ((ScreenXLen) \ 2)))
    LINE (xx&, YStart&)-(xx& + ScreenXLen - 1, YStart& + ScreenYLen - 1), 0, BF
    IF MapMode = 1 THEN DrawMap

  CASE Alt
    Strafe& = 1

  CASE Alt + 128
    Strafe& = 0
 
  CASE Shift
    Fast& = 1

  CASE Shift + 128
    Fast& = 0


  CASE ELSE
  GOTO Getkey

END SELECT

    IF Pa& < 0 THEN Pa& = 360 - Turnrate
    Pa& = Pa& MOD 360

'-------------------------------------------------------------------
'                     Update Screen
'-------------------------------------------------------------------
    IF turn = 1 THEN Update
    
    IF Level(Px& \ 1024, (Py& \ 1024)) > 0 THEN
      Px& = OldPx&
      Py& = OldPy&
    ELSE
      IF turn = 0 THEN Update
    END IF

    IF MapMode = 1 THEN DrawMap

    IF MapMode = 1 THEN
      xx& = ((160 - ((ScreenXLen) \ 2)))
       LINE ((xx& + (OldPx& / 1024) * (ScreenXLen / (LevelXLen)) + Sine((OldPa& + 360) MOD 360) * -5), YStart& + (OldPy& / 1024) * (ScreenYLen / (LevelYLen)) + Cosine((OldPa& + 360) MOD 360) * -5)-((xx& + (OldPx& / 1024) * (ScreenXLen / (LevelXLen)) + Sine((OldPa& + 360) MOD 360) * 5), YStart& + (OldPy& / 1024) * (ScreenYLen / (LevelYLen)) + Cosine((OldPa& + 360) MOD 360) * 5), 0
    END IF

    IF MapMode = 1 THEN
       xx& = ((160 - ((ScreenXLen) \ 2)))
       LINE ((xx& + (Px& / 1024) * (ScreenXLen / (LevelXLen)) + Sine((Pa& + 360) MOD 360) * -5), YStart& + (Py& / 1024) * (ScreenYLen / (LevelYLen)) + Cosine((Pa& + 360) MOD 360) * -5)-((xx& + (Px& / 1024) * (ScreenXLen / (LevelXLen)) + Sine((Pa& + 360) MOD 360) * 5), YStart& + (Py& / 1024) * (ScreenYLen / (LevelYLen)) + Cosine((Pa& + 360) MOD 360) * 5), 14
    END IF
LOOP

DO WHILE LEN(INKEY$): LOOP

    
   

'Leveldata
'-------------

'a number between 0 - (-16) : a Sprite
'a number between 1 - 16: a Wall


Leveldata:
DATA 008,011,008,011,008,011,008,011,008,011,008,011,008,011,008,011,008,011,008,011
DATA 011,000,006,005,000,000,000,000,000,008,000,000,000,000,000,000,000,000,000,008
DATA 008,000,005,006,000,005,006,005,000,011,000,000,000,000,000,000,000,000,000,011
DATA 011,000,006,000,000,006,000,006,000,008,000,000,006,003,006,003,006,000,000,008
DATA 008,000,005,000,000,005,000,005,000,000,000,000,000,000,000,000,003,000,000,011
DATA 011,000,006,000,005,006,000,006,000,008,000,000,000,000,000,000,006,000,000,008
DATA 008,000,005,000,000,000,000,005,000,011,000,000,000,-06,000,000,003,000,000,011
DATA 011,000,006,005,006,005,000,006,000,008,000,000,000,000,000,000,006,000,000,008
DATA 008,000,000,000,000,000,000,005,000,011,000,000,003,006,003,006,003,000,000,011
DATA 011,008,011,008,011,008,011,008,000,008,000,000,000,000,000,000,000,000,000,008
DATA 008,011,008,011,008,011,008,011,000,011,008,011,008,011,008,011,008,011,000,011
DATA 011,000,000,000,000,000,000,000,000,008,005,006,000,000,000,000,000,005,000,008
DATA 008,000,000,000,000,000,000,000,000,011,000,005,000,005,000,006,000,006,000,011
DATA 011,000,000,006,005,006,000,000,000,008,000,006,000,006,000,005,000,005,000,008
DATA 008,-11,000,005,000,005,000,000,000,000,000,005,000,006,000,006,000,006,000,011
DATA 011,000,000,006,000,006,000,000,000,008,000,006,000,005,000,005,000,005,000,008
DATA 008,000,000,005,000,005,000,000,000,011,000,005,000,006,000,006,000,006,000,011
DATA 011,000,000,000,000,000,-05,000,000,008,000,006,000,005,000,005,006,005,000,008
DATA 008,000,000,000,000,000,000,000,000,011,000,000,000,006,000,000,000,000,000,011
DATA 011,008,011,008,011,008,011,008,011,008,011,008,011,008,011,008,011,008,011,008



'Palettedata
'-----------

Pal:
DATA  0 , 0 , 0
DATA  0 , 0 , 42
DATA  0 , 42 , 0
DATA  0 , 42 , 42
DATA  42 , 0 , 0
DATA  42 , 0 , 42
DATA  42 , 21 , 0
DATA  42 , 42 , 42
DATA  21 , 21 , 21
DATA  21 , 21 , 63
DATA  21 , 63 , 21
DATA  21 , 63 , 63
DATA  63 , 21 , 21
DATA  45 , 0 , 45
DATA  63 , 63 , 21
DATA  63 , 63 , 63
DATA  26 , 8 , 8
DATA  29 , 11 , 11
DATA  32 , 14 , 14
DATA  35 , 17 , 17
DATA  38 , 20 , 20
DATA  41 , 23 , 23
DATA  44 , 26 , 26
DATA  47 , 29 , 29
DATA  50 , 32 , 32
DATA  53 , 35 , 35
DATA  55 , 37 , 37
DATA  58 , 40 , 40
DATA  63 , 45 , 45
DATA  63 , 48 , 48
DATA  63 , 51 , 51
DATA  63 , 54 , 54
DATA  11 , 0 , 0
DATA  13 , 0 , 0
DATA  15 , 0 , 0
DATA  17 , 0 , 0
DATA  19 , 0 , 0
DATA  23 , 0 , 0
DATA  27 , 0 , 0
DATA  31 , 0 , 0
DATA  35 , 0 , 0
DATA  39 , 0 , 0
DATA  43 , 0 , 0
DATA  47 , 0 , 0
DATA  51 , 0 , 0
DATA  55 , 0 , 0
DATA  59 , 0 , 0
DATA  63 , 0 , 0
DATA  8 , 26 , 8
DATA  11 , 29 , 11
DATA  14 , 32 , 14
DATA  17 , 35 , 17
DATA  20 , 38 , 20
DATA  23 , 41 , 23
DATA  26 , 44 , 26
DATA  29 , 47 , 29
DATA  32 , 50 , 32
DATA  35 , 53 , 35
DATA  37 , 55 , 37
DATA  40 , 58 , 40
DATA  45 , 63 , 45
DATA  48 , 63 , 48
DATA  51 , 63 , 51
DATA  54 , 63 , 54
DATA  0 , 11 , 0
DATA  0 , 13 , 0
DATA  0 , 15 , 0
DATA  0 , 17 , 0
DATA  0 , 19 , 0
DATA  0 , 23 , 0
DATA  0 , 27 , 0
DATA  0 , 31 , 0
DATA  0 , 35 , 0
DATA  0 , 39 , 0
DATA  0 , 43 , 0
DATA  0 , 47 , 0
DATA  0 , 51 , 0
DATA  0 , 55 , 0
DATA  0 , 59 , 0
DATA  0 , 63 , 0
DATA  0 , 8 , 26
DATA  0 , 11 , 29
DATA  0 , 14 , 32
DATA  0 , 17 , 35
DATA  0 , 20 , 38
DATA  0 , 23 , 41
DATA  0 , 26 , 44
DATA  0 , 29 , 47
DATA  0 , 32 , 50
DATA  0 , 35 , 53
DATA  0 , 37 , 55
DATA  0 , 40 , 58
DATA  0 , 45 , 63
DATA  0 , 48 , 63
DATA  0 , 51 , 63
DATA  0 , 54 , 63
DATA  0 , 0 , 11
DATA  0 , 0 , 13
DATA  0 , 0 , 15
DATA  0 , 0 , 17
DATA  0 , 0 , 19
DATA  0 , 0 , 23
DATA  0 , 0 , 27
DATA  0 , 0 , 31
DATA  0 , 0 , 35
DATA  0 , 0 , 39
DATA  0 , 0 , 43
DATA  0 , 0 , 47
DATA  0 , 0 , 51
DATA  0 , 0 , 55
DATA  0 , 0 , 59
DATA  0 , 0 , 63
DATA  7 , 7 , 7
DATA  10 , 10 , 10
DATA  13 , 13 , 13
DATA  16 , 16 , 16
DATA  19 , 19 , 19
DATA  23 , 23 , 23
DATA  27 , 27 , 27
DATA  31 , 31 , 31
DATA  35 , 35 , 35
DATA  39 , 39 , 39
DATA  43 , 43 , 43
DATA  47 , 47 , 47
DATA  51 , 51 , 51
DATA  55 , 55 , 55
DATA  59 , 59 , 59
DATA  63 , 63 , 63
DATA  26 , 2 , 0
DATA  31 , 4 , 0
DATA  35 , 4 , 0
DATA  38 , 5 , 0
DATA  41 , 6 , 0
DATA  43 , 8 , 0
DATA  45 , 10 , 0
DATA  47 , 12 , 0
DATA  49 , 14 , 0
DATA  51 , 16 , 0
DATA  53 , 18 , 0
DATA  55 , 20 , 0
DATA  57 , 22 , 0
DATA  59 , 24 , 0
DATA  61 , 27 , 0
DATA  63 , 30 , 0
DATA  17 , 12 , 12
DATA  20 , 15 , 15
DATA  23 , 18 , 18
DATA  26 , 21 , 21
DATA  29 , 24 , 24
DATA  32 , 27 , 27
DATA  35 , 30 , 30
DATA  38 , 33 , 33
DATA  41 , 36 , 36
DATA  44 , 39 , 39
DATA  47 , 42 , 42
DATA  50 , 45 , 45
DATA  53 , 48 , 48
DATA  56 , 51 , 51
DATA  59 , 54 , 54
DATA  62 , 57 , 57
DATA  13 , 0 , 4
DATA  20 , 0 , 6
DATA  23 , 0 , 6
DATA  26 , 0 , 8
DATA  30 , 0 , 8
DATA  33 , 0 , 10
DATA  36 , 0 , 12
DATA  39 , 0 , 14
DATA  42 , 0 , 16
DATA  45 , 0 , 18
DATA  48 , 0 , 20
DATA  51 , 0 , 22
DATA  54 , 0 , 24
DATA  57 , 0 , 26
DATA  60 , 0 , 28
DATA  63 , 0 , 30
DATA  12 , 12 , 17
DATA  15 , 15 , 20
DATA  18 , 18 , 23
DATA  21 , 21 , 26
DATA  24 , 24 , 29
DATA  27 , 27 , 32
DATA  30 , 30 , 35
DATA  33 , 33 , 38
DATA  36 , 36 , 41
DATA  39 , 39 , 44
DATA  42 , 42 , 47
DATA  45 , 45 , 50
DATA  48 , 48 , 53
DATA  51 , 51 , 56
DATA  54 , 54 , 59
DATA  57 , 57 , 62
DATA  22 , 14 , 0
DATA  25 , 17 , 0
DATA  28 , 20 , 0
DATA  31 , 23 , 0
DATA  34 , 26 , 0
DATA  37 , 29 , 0
DATA  40 , 32 , 0
DATA  43 , 35 , 0
DATA  45 , 38 , 0
DATA  47 , 41 , 0
DATA  49 , 44 , 0
DATA  51 , 47 , 0
DATA  53 , 50 , 0
DATA  55 , 53 , 0
DATA  57 , 56 , 0
DATA  59 , 59 , 0
DATA  10 , 8 , 0
DATA  12 , 9 , 0
DATA  14 , 11 , 0
DATA  16 , 12 , 0
DATA  18 , 13 , 0
DATA  20 , 14 , 0
DATA  22 , 15 , 0
DATA  24 , 16 , 0
DATA  25 , 16 , 0
DATA  27 , 17 , 0
DATA  30 , 18 , 0
DATA  33 , 20 , 0
DATA  37 , 22 , 0
DATA  40 , 24 , 0
DATA  41 , 26 , 0
DATA  42 , 28 , 0
DATA  0 , 11 , 11
DATA  0 , 13 , 13
DATA  0 , 15 , 15
DATA  0 , 17 , 17
DATA  0 , 19 , 19
DATA  0 , 23 , 23
DATA  0 , 27 , 27
DATA  0 , 31 , 31
DATA  0 , 35 , 35
DATA  0 , 39 , 39
DATA  0 , 43 , 43
DATA  0 , 47 , 47
DATA  0 , 51 , 51
DATA  0 , 55 , 55
DATA  0 , 59 , 59
DATA  0 , 63 , 63
DATA  11 , 0 , 11
DATA  13 , 0 , 13
DATA  15 , 0 , 15
DATA  17 , 0 , 17
DATA  19 , 0 , 19
DATA  23 , 0 , 23
DATA  27 , 0 , 27
DATA  31 , 0 , 31
DATA  35 , 0 , 35
DATA  39 , 0 , 39
DATA  43 , 0 , 43
DATA  47 , 0 , 47
DATA  51 , 0 , 51
DATA  55 , 0 , 55
DATA  59 , 0 , 59
DATA  63 , 0 , 63

ShowExit
END



Texture:

'XLenght, YLenght

DATA 3,5


DATA 07, 07, 07
DATA 06, 07, 06
DATA 07, 07, 07
DATA 06, 07, 06
DATA 07, 07, 07






ErrorHandler:
SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1: PRINT STRING$(80, " ")
LOCATE 1, 1
Center "þ ERROR þ"
COLOR 7, 0
PRINT
PRINT " Error number";
COLOR 11
PRINT ERR;
COLOR 7
PRINT "has occured."
PRINT
PRINT "Error description: "
PRINT
COLOR 15
PRINT Error$(ERR)
PRINT
PRINT
COLOR 14
PRINT " þ Memory status"
COLOR 7
PRINT "   ú String Space:",
COLOR 11
PRINT FRE("")
COLOR 7
PRINT "   ú Unused Stack Space:",
COLOR 11
PRINT FRE(-2)
COLOR 7
PRINT "   ú Array Space:",
COLOR 11
PRINT FRE(-1)
COLOR 7
PRINT
COLOR 2
PRINT " Aborting program..."
END

SUB Center (Text$)
'-------------------------------------------------------------------
'                    Centers Text$ on screen
'-------------------------------------------------------------------


LOCATE CSRLIN, 40 - LEN(Text$) \ 2
PRINT Text$
END SUB

DEFSNG D
SUB DrawMap

'-------------------------------------------------------------------
'             Draws the map with raytraced walls
'-------------------------------------------------------------------

MapX& = 0
MapY& = 0
FOR yy& = YStart& TO YStart& + ScreenYLen STEP ScreenYLen / (LevelYLen)
  FOR xx& = ((160 - ((ScreenXLen) \ 2))) TO ScreenXLen + (160 - (ScreenXLen \ 2)) STEP ScreenXLen / (LevelXLen)
    IF MapX& > LevelXLen - 1 THEN EXIT FOR
    IF Visible&(MapX&, MapY&) THEN
      LINE (xx&, yy&)-(xx& + ScreenXLen / (LevelXLen) - 1, yy& - 1 + ScreenYLen / (LevelYLen - 1)), Shade&(MapX&, MapY&), BF 'Level(MapX&, MapY&) * 16, BF
      Shade&(MapX&, MapY&) = Shade&(MapX&, MapY&) - 1
      IF Shade&(MapX&, MapY&) < (OrgShade&(MapX&, MapY&)) THEN Shade&(MapX&, MapY&) = (OrgShade&(MapX&, MapY&))
    END IF
    MapX& = MapX& + 1
  NEXT
  MapY& = MapY& + 1
  IF MapY& > LevelYLen - 1 THEN EXIT FOR
  MapX& = 0
NEXT

DO WHILE LEN(INKEY$): LOOP


'-------------------------------------------------------------------
'               Update framerate every 2 seconds
'-------------------------------------------------------------------
  IF Framerate = 1 THEN
    IF TIMER >= Start& + 2 THEN
      COLOR 14
      LOCATE 1, 1: PRINT INT(Frame& / 2); "fps  "
      Frame& = 0
      Start& = INT(TIMER)
    END IF

    Frame& = Frame& + 1
  END IF


END SUB

DEFSNG X-Y
SUB DrawScreen
xx& = ((160 - ((ScreenXLen) \ 2)))
VIEW SCREEN (xx&, YStart&)-(xx& + ScreenXLen - 1, YStart& + ScreenYLen - 1)


'-------------------------------------------------------------------
'                   Draws the screen from the buffer
'-------------------------------------------------------------------

xxx& = 0
yyy& = 0
Buffer& = 0
Down& = YStart& + ScreenYLen + 1

IF Textures = 0 THEN
  FOR xx& = ((160 - ((ScreenXLen) \ 2))) TO ScreenXLen + (160 - (ScreenXLen \ 2)) STEP ScreenStep
    LINE (xx&, YStart&)-(xx& + ScreenStep - 1, Dist&(BufferDist&(Buffer&)) + YStart&), SkyColor, BF
    LINE (xx&, Dist&(BufferDist&(Buffer&)) + YStart& + 1)-(xx& + ScreenStep - 1, Dist2&(BufferDist&(Buffer&)) + YStart& + 1), BufferCol&(Buffer&), BF
    LINE (xx&, Down&)-(xx& + ScreenStep - 1, Dist2&(BufferDist&(Buffer&)) + YStart& + 2), FloorColor, BF
    Buffer& = Buffer& + 1
  NEXT
ELSE
  FOR xx& = ((160 - ((ScreenXLen) \ 2))) TO ScreenXLen + (160 - (ScreenXLen \ 2)) STEP ScreenStep
    OldDist& = BufferDist&(Buffer&)
    IF (BufferDist&(Buffer&) \ 4) > 15 THEN BufferDist&(Buffer&) = 15 \ 4
    TyStep = (Dist2&(OldDist&) - Dist&(OldDist&)) / Ty&

    YPlace1& = Dist&(OldDist&)
    YPlace2& = Dist2&(OldDist&)
    yyy& = 0
    YStep = (YPlace2& - YPlace1&) / Ty&
    FOR y = YPlace1& TO YPlace2& STEP YStep
      Col& = (Texture(xxx&, yyy&)) * 16
      YPos& = y + YStep - 1
      IF YPos& >= YPlace2& THEN YPos& = YPlace2& - 1
      LINE (xx&, y + YStart&)-(xx& + ScreenStep - 1, YPos& + YStart&), Col& - (BufferDist&(Buffer&) \ 4), BF
      yyy& = yyy& + 1
      IF yyy& > Ty& - 1 THEN yyy& = Ty& - 1
    NEXT
    yyy& = 0
    LINE (xx&, YStart&)-(xx& + ScreenStep - 1, Dist&(OldDist&) + YStart& - 1), SkyColor, BF
    LINE (xx&, Down&)-(xx& + ScreenStep - 1, Dist2&(OldDist&) + YStart&), FloorColor, BF

    xxx& = xxx& + 1
    IF xxx& > Tx& - 1 THEN xxx& = 0
    yyy& = 0
    Buffer& = Buffer& + 1
  NEXT
END IF


'-------------------------------------------------------------------
'                        Draw sprites
'-------------------------------------------------------------------

IF Sprite& > 0 AND Sprites = 1 THEN
  FOR i& = 1 TO Sprite&
    xx& = ((160 - ((ScreenXLen) \ 2)))
    IF Spritecount&(i&) > 0 THEN SpriteX&(i&) = SpriteX&(i&) / Spritecount&(i&)
    Size& = 16 - SpriteDist&(i&) \ 2
    IF Size& < 0 THEN Size& = 0
    CIRCLE (SpriteX&(i&) + xx&, YStart& + (ScreenYLen \ 2)), Size&, Colr&(-Level(SpriteMapX&(i&), SpriteMapY&(i&)), SpriteDist&(i&))
  NEXT
END IF


VIEW SCREEN (0, 0)-(319, 199)


'-------------------------------------------------------------------
'               Update framerate every 2 seconds
'-------------------------------------------------------------------

  IF Framerate = 1 THEN
    IF TIMER >= Start& + 2 THEN
      COLOR 14
      LOCATE 1, 1: PRINT INT(Frame& / 2); "fps  "
      Frame& = 0
      Start& = INT(TIMER)
    END IF

    Frame& = Frame& + 1
  END IF

DO WHILE LEN(INKEY$): LOOP




END SUB

DEFINT X-Y
FUNCTION Error$ (Virhe)

'-------------------------------------------------------------------
'         Returns error description for error number Virhe
'-------------------------------------------------------------------

SELECT CASE Virhe
CASE IS = 1
Error$ = "NEXT without FOR"
CASE IS = 2
Error$ = "Syntax error"
CASE IS = 3
Error$ = "RETURN without GOSUB"
CASE IS = 4
Error$ = "Out of DATA"
CASE IS = 5
Error$ = "Illegal function call"
CASE IS = 6
Error$ = "Overflow"
CASE IS = 7
Error$ = "Out of memory"
CASE IS = 8
Error$ = "Label not defined"
CASE IS = 9
Error$ = "Subscript out of range"
CASE IS = 10
Error$ = "Duplicate definition"
CASE IS = 11
Error$ = "Division by zero"
CASE IS = 12
Error$ = "Illegal in direct mode"
CASE IS = 13
Error$ = "Type mismatch"
CASE IS = 14
Error$ = "Out of string space"
CASE IS = 16
Error$ = "String formula too complex"
CASE IS = 17
Error$ = "Cannot continue"
CASE IS = 18
Error$ = "Function not defined"
CASE IS = 19
Error$ = "No RESUME"
CASE IS = 20
Error$ = "RESUME without error"
CASE IS = 24
Error$ = "Device timeout"
CASE IS = 26
Error$ = "Device fault"
CASE IS = 27
Error$ = "Out of paper"
CASE IS = 29
Error$ = "WHILE without WEND"
CASE IS = 30
Error$ = "WEND without WHILE"
CASE IS = 33
Error$ = "Duplicate label"
CASE IS = 35
Error$ = "Subprogram not defined"
CASE IS = 37
Error$ = "Argument-count mismatch"
CASE IS = 38
Error$ = "Array not defined"
CASE IS = 40
Error$ = "Variable required"
CASE IS = 50
Error$ = "FIELD overflow"
CASE IS = 51
Error$ = "Internal error"
CASE IS = 52
Error$ = "Bad file name of number"
CASE IS = 53
Error$ = "File not found"
CASE IS = 54
Error$ = "Bad file mode"
CASE IS = 55
Error$ = "File already open"
CASE IS = 56
Error$ = "FIELD statement active"
CASE IS = 57
Error$ = "Device I/O error"
CASE IS = 58
Error$ = "File already exists"
CASE IS = 59
Error$ = "Bad record lenght"
CASE IS = 61
Error$ = "Disk full"
CASE IS = 62
Error$ = "Input past end of file"
CASE IS = 63
Error$ = "Bad record number"
CASE IS = 64
Error$ = "Bad file name"
CASE IS = 67
Error$ = "Too many files"
CASE IS = 68
Error$ = "Device unavailable"
CASE IS = 69
Error$ = "Communication-buffer overflow"
CASE IS = 70
Error$ = "Permission denied"
CASE IS = 71
Error$ = "Disk not ready"
CASE IS = 72
Error$ = "Disk-media error"
CASE IS = 73
Error$ = "Feature unavailable"
CASE IS = 74
Error$ = "Rename across disks"
CASE IS = 75
Error$ = "Path/File access error"
CASE IS = 76
Error$ = "Path not found"
CASE ELSE
Error$ = ""
END SELECT
END FUNCTION

DEFLNG X-Y
SUB ShowExit
'-------------------------------------------------------------------
'                   Shows the exit screen
'-------------------------------------------------------------------

SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1: PRINT STRING$(80, " ")
LOCATE 1, 1
Center "DooMed v3.2 - Raytracer for QBasic by Sami Ky”stil„ 1997"
COLOR 7, 0
PRINT
PRINT " You are free to use this code in your own programs, as long as"
PRINT " credit is given."
PRINT
COLOR 14
PRINT " þ Final location of player"
COLOR 7
PRINT "   ú X:";
COLOR 11: PRINT Px&;
COLOR 7
PRINT "Y:";
COLOR 11: PRINT Py&
COLOR 7
PRINT "   ú Sector (";
COLOR 11
PRINT Trim$(Px& \ 1024);
COLOR 7
PRINT ",";
COLOR 11
PRINT Trim$(Py& \ 1024);
COLOR 7
PRINT ")"
PRINT "   ú Angle:";
COLOR 11
PRINT Pa&;
COLOR 7
PRINT "degrees"

FOR y& = 2 TO LevelYLen + 1 STEP 2
  FOR x& = 2 TO LevelXLen + 1
    IF Level(x& - 2, y& - 2) <> 0 THEN Char$ = "ß"
    IF Level(x& - 2, y& - 1) <> 0 THEN Char$ = "Ü"
    IF Level(x& - 2, y& - 1) <> 0 AND Level(x& - 2, y& - 2) <> 0 THEN Char$ = "Û"
    IF Level(x& - 2, y& - 1) <= 0 AND Level(x& - 2, y& - 2) <= 0 THEN Char$ = " "
    COLOR 3, 0
    IF Px& \ 1024 = x& - 2 AND Py& \ 1024 = y& - 2 THEN COLOR 3, 4
    IF Px& \ 1024 = x& - 2 AND Py& \ 1024 = y& - 1 THEN COLOR 3, 4
    LOCATE y& \ 2 + 4, x& + 40: PRINT Char$
  NEXT
NEXT


LOCATE 11, 1
COLOR 14
PRINT " þ Memory status"
COLOR 7
PRINT "   ú String Space:",
COLOR 11
PRINT FRE("")
COLOR 7
PRINT "   ú Unused Stack Space:",
COLOR 11
PRINT FRE(-2)
COLOR 7
PRINT "   ú Array Space:",
COLOR 11
PRINT FRE(-1)

PRINT
COLOR 14
PRINT " þ Toggles"
COLOR 7
PRINT "   ú Framerate display:",
COLOR 11
IF Framerate = 1 THEN PRINT " On" ELSE PRINT " Off"
COLOR 7
PRINT "   ú Textures:",
COLOR 11
IF Textures = 1 THEN PRINT " On" ELSE PRINT " Off"
COLOR 7
PRINT "   ú Sprites:", ,
COLOR 11
IF Sprites = 1 THEN PRINT " On" ELSE PRINT " Off"
COLOR 7

END SUB

DEFSNG X-Y
SUB ShowIntro
'-------------------------------------------------------------------
'           Shows the welcoming screen and calculates tables
'-------------------------------------------------------------------


SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1: PRINT STRING$(80, " ")
LOCATE 1, 1
Center "DooMed v3.2 - Raytracer for QBasic by Sami Ky”stil„ 1997"
COLOR 9, 0
PRINT
Center " Keys:"
COLOR 1
COLOR 15
PRINT
PRINT " Up arrow",
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Move forward";
COLOR 15
PRINT , , "Alt    ";
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Strafe"
COLOR 15
PRINT " Down arrow",
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Move backward";
COLOR 15
PRINT , , "Shift  ";
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Run"
COLOR 15
PRINT " Left arrow",
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Turn left";
COLOR 15
PRINT , , , "Esc    ";
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Exit"
COLOR 15
PRINT " Right arrow",
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Turn right"
COLOR 15
PRINT " TAB",
COLOR 8
PRINT " - ";
COLOR 7
PRINT " Enable/disable map mode"
PRINT
COLOR 2
Center " Modify the constants at the start of the program to create"
Center " custom shading levels and toggle framerate display etc."
COLOR 7
PRINT
COLOR 14
PRINT " þ Init game engine ";
COLOR 7
PRINT "(";
COLOR 11
PRINT Trim$(ScreenXLen); "x"; Trim$(ScreenYLen);
COLOR 7
PRINT " mode)"
COLOR 7
PRINT "   ú Calculating Sine and Cosine tables...";

'-------------------------------------------------------------------
'                    Make SINE & COSINE tables
'-------------------------------------------------------------------
FOR i = -Viewwidth TO 360 + Viewwidth
  Sine(i) = SIN(i * Pi / 180)
  Cosine(i) = COS(i * Pi / 180)
NEXT

FOR i = -Viewwidth TO 360 + Viewwidth
  Sine(i) = SIN(i * Pi / 180)
  Cosine(i) = COS(i * Pi / 180)
NEXT
PRINT "Done"
PRINT "   ú Calculating Distance table...";

'-------------------------------------------------------------------
'                     Make Distance table
'-------------------------------------------------------------------

FOR Colorvalue& = 1 TO 16
  Level(0, 0) = Colorvalue&
  FOR d& = 1 TO 300
    Distance1& = 480 / d&
    Height& = Distance1& + Distance1&
    Distance2& = ScreenYLen \ 2 - Distance1&
    YPlace2& = Height& + Distance2&
    YPlace1& = Height& \ 30 + Distance2&
    Dist&(d&) = YPlace1&
    Dist2&(d&) = YPlace2&


    Col& = Level(0, 0) * 16 - (d& \ 4) - 1 - Darkness - Light \ 1024
    IF Col& < (Level(0, 0) - 1) * 16 THEN Col& = (Level(0, 0) - 1) * 16
    IF Col& > (Level(0, 0) + 1) * 16 THEN Col& = (Level(0, 0) + 1) * 16
    Colr&(Colorvalue&, d&) = Col&
  NEXT
NEXT







PRINT "Done"
PRINT "   ú Reading Level (";
COLOR 11
PRINT Trim(LevelXLen); "x"; Trim(LevelYLen);
COLOR 7
PRINT ") data...";

'-------------------------------------------------------------------
'                       Read LevelDATA
'-------------------------------------------------------------------

RESTORE Leveldata
FOR y = 0 TO LevelYLen - 1
  FOR x = 0 TO LevelXLen - 1
    READ Level(x, y)
  NEXT
NEXT
PRINT "Done"


PRINT "   ú Reading texture (";

'-------------------------------------------------------------------
'                       Read Texture
'-------------------------------------------------------------------

RESTORE Texture
READ Tx&, Ty&
COLOR 11
PRINT Trim(INT(Tx&)); "x"; Trim(INT(Ty&));
COLOR 7
PRINT ")...";

FOR y = 0 TO Ty& - 1
  FOR x = 0 TO Tx& - 1
    READ Texture(x, y)
  NEXT
NEXT
PRINT "Done";
COLOR 8
IF Textures = 1 THEN PRINT , "(Textures:on)" ELSE PRINT , "(Textures:off)"



COLOR 14
PRINT " þ Memory status"
COLOR 7
PRINT "   ú String Space:",
COLOR 11
PRINT FRE("")
COLOR 7
PRINT "   ú Unused Stack Space:",
COLOR 11
PRINT FRE(-2)
COLOR 7
PRINT "   ú Array Space:",
COLOR 11
PRINT FRE(-1)

COLOR 4
Center "- Press any key to continue -"


DO: LOOP UNTIL INKEY$ <> ""
END SUB

DEFINT X-Y
SUB Smooth (xpos&, YPos&, XLen, YLen, Times, Rate, Lowest)

'-------------------------------------------------------------------
'                 Smooths an area of the screen
'
' Xpos&, Ypos&  - Start X,Y
'   XLen, YLen  - Lenght X,Y
'        Times  - Iteration times
'         Rate  - Smoothing rate
'       Lowest  - Lowest possible color value

'-------------------------------------------------------------------



DEF SEG = &HA000
done = 0
DO
  FOR y& = 0 TO YLen
    FOR x& = 0 TO XLen
      avg% = 0
      avg% = avg% + PEEK((y& + YPos& - 1) * 320 + (x& + xpos&))
      avg% = avg% + PEEK((y& + 1 + YPos&) * 320 + (x& + xpos&))
      avg% = avg% + PEEK((y& + YPos&) * 320 + (x& - 1 + xpos&))
      avg% = avg% + PEEK((y& + YPos&) * 320 + (x& + 1 + xpos&))
 
      avg% = avg% + PEEK((y& + YPos& - 1) * 320 + (x& + xpos& - 1))
      avg% = avg% + PEEK((y& + YPos& - 1) * 320 + (x& + xpos& + 1))
      avg% = avg% + PEEK((y& + YPos& + 1) * 320 + (x& + xpos& - 1))
      avg% = avg% + PEEK((y& + YPos& + 1) * 320 + (x& + xpos& + 1))
      avg% = avg% \ 8
      avg% = avg% - Rate
      IF avg% < Lowest THEN avg% = Lowest
      POKE ((y& + YPos&) * 320 + x& + xpos&), avg%
    NEXT
  NEXT
  done = done + 1
LOOP UNTIL done >= Times


END SUB

DEFLNG D, X-Y
FUNCTION Trim$ (Number)
'-------------------------------------------------------------------
'  Converts integer numbers into strings and removes null padding
'-------------------------------------------------------------------



Trim$ = LTRIM$(RTRIM$(STR$(Number)))
END FUNCTION

DEFSNG D, X-Y
SUB Update
ON ERROR GOTO 0

'-------------------------------------------------------------------
'                    Updates the engine
'-------------------------------------------------------------------
Buffer& = (ScreenXLen / ScreenStep)
Sprite& = 0                                         'Set sprite index to 0
Spritecount&(0) = 0

    FOR A& = Pa& - Viewwidth TO Pa& + Viewwidth STEP 1


'-------------------------------------------------------------------
'                   Calculate ray angles
'-------------------------------------------------------------------

    x& = Px&
    y& = Py&
    XStep& = Sine(A&) * 480 \ 4
    YStep& = Cosine(A&) * 480 \ 4
    d& = 0
    

'-------------------------------------------------------------------
'                       Fire a ray
'-------------------------------------------------------------------

Scan:
      DO
        d& = d& + 1
        x& = x& + XStep&
        y& = y& + YStep&
        Found& = Level(x& \ 1024, y& \ 1024)
      LOOP UNTIL Found&

      IF Found& < 0 AND Sprites = 0 THEN GOTO Scan
      Visible&(x& \ 1024, y& \ 1024) = 1
      

'-------------------------------------------------------------------
'             Get wall height from Distance table
'-------------------------------------------------------------------

       YPlace1& = Dist&(d&)
       YPlace2& = Dist2&(d&)


'-------------------------------------------------------------------
'                     Calculate sprites
'-------------------------------------------------------------------

      IF Found& < 0 AND Sprites = 1 THEN
        IF SpriteMapX&(Sprite&) = x& \ 1024 AND SpriteMapY&(Sprite&) = y& \ 1024 THEN
          SpriteX&(Sprite&) = SpriteX&(Sprite&) + (Buffer& * ScreenStep)
          Spritecount&(Sprite&) = Spritecount&(Sprite&) + 1
        ELSE
          Sprite& = Sprite& + 1
          Spritecount&(Sprite&) = 0
          SpriteMapX&(Sprite&) = x& \ 1024
          SpriteMapY&(Sprite&) = y& \ 1024
          SpriteDist&(Sprite&) = d&
        END IF
        GOTO Scan
      END IF


'-------------------------------------------------------------------
'                Get wall shade from Color table
'-------------------------------------------------------------------

      IF Level(x& \ 1024, y& \ 1024) > 0 THEN Col& = Colr&(Level(x& \ 1024, y& \ 1024), d&) ELSE GOTO Scan
      Shade&(x& \ 1024, y& \ 1024) = Col&
      OrgShade&(x& \ 1024, y& \ 1024) = (Level(x& \ 1024, y& \ 1024) - 1) * 16
    


'-------------------------------------------------------------------
'                      Store wall heights
'-------------------------------------------------------------------

    BufferDist&(Buffer&) = d&
    BufferCol&(Buffer&) = Col&
    Buffer& = Buffer& - 1
    NEXT


END SUB