'===========================================================================
' Subject: 3D ENGINE W/LEVEL EDITOR          Date: 02-04-97 (03:14)       
' Author:  Bradley Wagner                    Code: QB, QBasic, PDS        
' Origin:  BradWagner@msn.com              Packet: GRAPHICS.ABC
'===========================================================================
'     Attached are two files. One is a level builder i created for that raycast
'engine, and the second is an updated version of the raycast engine.

'3dengine.bas:
'------------------------------------------------------------------------------
'Here is a new version (I merely added my keyboard ISR to the last).  Don't be
'afraid to hold down multiple keys! :)

DECLARE SUB screensetup ()
DECLARE SUB makeworld ()
DECLARE SUB maketables ()


DECLARE SUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)
DECLARE SUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)
DECLARE SUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)
DECLARE SUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)

'$STATIC

CONST NUM.KEYS = 10
CONST INDEX.UP = 0
CONST INDEX.DOWN = 1
CONST INDEX.LEFT = 2
CONST INDEX.RIGHT = 3
CONST INDEX.CTRL = 4
CONST INDEX.ALT = 5
CONST INDEX.SPACE = 6
CONST INDEX.ESC = 7
CONST INDEX.ENTER = 8
CONST INDEX.RSHIFT = 9

DIM SHARED KEY.TABLE(0 TO (NUM.KEYS - 1)) AS INTEGER
DIM SHARED RAWKEY AS INTEGER
DIM SHARED OLD.ISR.SEG AS INTEGER, OLD.ISR.OFF AS INTEGER


' Just a minor change, but it's good for a speed increase
' of about 30% on my P133. Changed the LINE,BF to draw the
' walls into seperate LINE's.

'=======================================================================
' RAY CASTER 3D sorta ENGINE thingymajig
'=======================================================================
' Wrote this about a month ago, it's a sort of wolfenstien\doom
' lookalike but all in native QBasic source! Uses an interesting ray
' Cheers, {:o)   Peter Cooper

' Clean-up by Brent P. Newhall

' Improvments by Nick Cangiani (nicksxe@gnn.com)
' Sped up maketables by v Zoelen AA (vsim@xs4all.nl)
' Minor improvement by Marc vd Dikkenberg (excel@xs4all.nl)
' Level Builder/Loading by Bradley Wagner (bradwagner@msn.com)

' Left arrow  == Move left
' Right arrow == Move right
' Up arrow    == Move forward
' Down arrow  == Move backward
' [ESC]       == Quit

DIM SHARED st%(0 TO 360)
DIM SHARED ct%(0 TO 360)
DIM SHARED a$(1 TO 10)
DIM SHARED Grid(1 TO 12, 1 TO 12)
px% = 15: py% = 35: sa% = 0
CLS
PRINT "Please wait...";
RANDOMIZE TIMER
makeworld
CALL KEYBOARD.IN(OLD.ISR.SEG, OLD.ISR.OFF)
maketables
screensetup
m% = 1
DO
  IF m% = 1 THEN
    IF P = 2 THEN PCOPY 2, 0 ELSE PCOPY 3, 0
    IF P = 2 THEN P = 3 ELSE P = 2
    m% = 0
  END IF
  FOR t% = sa% TO sa% + 59 STEP 1
    xb = st%(t% MOD 360) / 100              'get inc
    yb = ct%(t% MOD 360) / 100              'get inc
    bx = px%                                'decimal copy
    by = py%                                'decimal copy
    l% = 0                                  'reset length
    DO
      bx = bx + xb
      by = by + yb
      l% = l% + 1
      'k% = ASC(MID$(a$(CINT(by / 10)), CINT(bx / 10), 1)) - 48
      k% = Grid(CINT(by / 10), CINT(bx / 10))
    LOOP UNTIL k% <> 0
    LOCATE 1, 1
    'PRINT l%;        'this would print the distance to wall
    X% = (t% - sa%) * 5
    dd% = (1000 / l%)
    'LINE (X%, 1)-(X% + 5, 99 - dd%), 15, BF          'paint ceiling
    'LINE (X%, 101 + dd%)-(X% + 5, 200), 2, BF        'paint floor
    'LINE (X%, 100 - dd%)-(X% + 5, 100 + dd%), k%, BF 'paint walls

    FOR U% = 0 TO 4                                   'paint walls
       LINE (X% + U%, 100 - dd%)-(X% + U%, 100 + dd%), k%
    NEXT U%
    ' Could be even 20% faster: FOR U% = 0 to 4
    ' This will skip one line at the right of the screen, though.

    LINE (X%, 100 - dd%)-(X% + 5, 100 - dd%), 0      'top lines
    LINE (X%, 100 + dd%)-(X% + 5, 100 + dd%), 0      'bottom lines
  NEXT t%
  PCOPY 0, 1
  RAWKEY = 0: WHILE RAWKEY = 0: WEND
  IF KEY.TABLE(INDEX.RIGHT) THEN ' [LEFT]
    sa% = sa% + 3
    m% = 1
  END IF
  IF KEY.TABLE(INDEX.LEFT) THEN ' [RIGHT]
    sa% = (sa% + 357) MOD 360
    m% = 1
  END IF
  IF KEY.TABLE(INDEX.ESC) THEN ' [ESC]
    quit = 1
  END IF
  IF KEY.TABLE(INDEX.UP) THEN ' [UP]
    Oldpx% = px%: Oldpy% = py% ' Save where you are
    px% = px% + (st%((sa% + 30) MOD 360) / 30)
    py% = py% + (ct%((sa% + 30) MOD 360) / 30)
    IF Grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru walls?
      SOUND 80, 1
      px% = Oldpx% ' Forget it!  Don't move
      py% = Oldpy%
    ELSE
      m% = 1
    END IF
  END IF
    
  IF KEY.TABLE(INDEX.DOWN) THEN '[DOWN]
    Oldpx% = px%: Oldpy% = py% ' Save where you are
    px% = px% - (st%((sa% + 30) MOD 360) / 30)
    py% = py% - (ct%((sa% + 30) MOD 360) / 30)
    IF Grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru walls?
      SOUND 80, 1
      px% = Oldpx% ' Forget it!  Don't move
      py% = Oldpy%
    ELSE
      m% = 1
    END IF
  END IF
LOOP UNTIL quit > 0
SCREEN 0
WIDTH 80, 25


CALL KEYBOARD.OUT(OLD.ISR.SEG, OLD.ISR.OFF)


SYSTEM

' Level data (this way you can have walls colored 10, 11, etc.)
' 12x12    __
'         |  guy starts here somewhere
'        \|/
DATA  7, 8, 7, 8, 7, 8, 7, 8, 7, 8, 7, 8
DATA  8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7
DATA  7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8
DATA  8, 0, 8, 7, 8, 7, 8, 7, 8, 0, 0, 7
DATA  7, 0, 7, 0, 0, 0, 0, 0, 7, 0, 0, 8
DATA  8, 0, 8, 0, 8, 7, 8, 7, 8, 0, 0, 7
DATA  7, 0, 7, 0, 0, 0, 0, 0, 0, 0, 0, 8
DATA  8, 0, 8, 0, 8, 7, 8, 7, 8, 0, 0, 7
DATA  7, 0, 7, 0, 0, 0, 0, 0, 7, 0, 0, 8
DATA  8, 0, 8, 7, 8, 7, 8, 7, 8, 0, 0, 7
DATA  7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8
DATA  8, 7, 8, 7, 8, 7, 8, 7, 8, 7, 8, 7

' Old level.  If you want it, come and get it.
'  1, 9, 1, 9, 1, 9, 1, 9, 1, 9
'  9, 0, 0, 0, 0, 0, 0, 0, 0, 1
'  1, 0, 0, 0, 0, 0, 0, 4, 0, 9
'  9, 0, 1, 0, 0, 0, 5, 0, 0, 1
'  1, 0, 2, 0, 0, 4, 0, 0, 0, 9
'  9, 0, 3, 0, 0, 0, 0, 0, 0, 1
'  1, 0, 0, 0, 0, 7, 8, 0, 0, 9
'  9, 0, 5, 0, 0, 8, 7, 0, 0, 1
'  1, 0, 6, 0, 0, 0, 0, 0, 0, 9
'  9, 1, 9, 1, 9, 1, 9, 1, 9, 1
'-------------------------end of 3dengine.bas-----------------------------------------------------------

SUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)

    'GETVECT RETURNS THE ADDRESS OF A FUNCTION POINTED TO IN THE
    'INTERRUPT VECTOR TABLE (STARTS AT 0000:0000H)

    STATIC ASM AS STRING 'THE CODE FOR GETVECT

    STATIC INI AS INTEGER 'USED TO DETECT WHETHER GETVECT HAS PREVIOUSLY
                          'BEEN CALLED
    IF INI = 0 THEN
        
        'CREATE ML FUNCTION IF NOT ALREADY CREATED

        ASM = ASM + CHR$(&H55)                          'PUSH    BP
        ASM = ASM + CHR$(&H89) + CHR$(&HE5)             'MOV     BP,SP
        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV     BX,[BP+06]
        ASM = ASM + CHR$(&H8A) + CHR$(&H7)              'MOV     AL,[BX]
        ASM = ASM + CHR$(&HB4) + CHR$(&H35)             'MOV     AH,35
        ASM = ASM + CHR$(&HCD) + CHR$(&H21)             'INT     21
        ASM = ASM + CHR$(&H53)                          'PUSH    BX
        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV     BX,[BP+0A]
        ASM = ASM + CHR$(&H8C) + CHR$(&H7)              'MOV     [BX],ES
        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV     BX,[BP+08]
        ASM = ASM + CHR$(&H58)                          'POP     AX
        ASM = ASM + CHR$(&H89) + CHR$(&H7)              'MOV     [BX],AX
        ASM = ASM + CHR$(&H5D)                          'POP     BP
        ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'RETF    0006
        INI = 1 'FLAG CREATION
    END IF

    DEF SEG = VARSEG(ASM)
    CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN FUNCTION
END SUB

SUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)
    DIM RSGL AS INTEGER, RSGH AS INTEGER 'SEGMENT OF RAWKEY
    DIM ROFL AS INTEGER, ROFH AS INTEGER 'OFFSET OF RAWKEY

    DIM KSGL AS INTEGER, KSGH AS INTEGER 'SEGMENT OF KEY.TABLE
    DIM KOFL AS INTEGER, KOFH AS INTEGER 'OFFSET OF KEY.TABLE
   
    DIM BYTE AS STRING * 1 'USED TO ACTIVATE IRQ 1 IN PIC

    STATIC ASM AS STRING 'HOLDS ISR

    RSGL = VARSEG(RAWKEY) AND &HFF 'LOAD LOW "BYTE" SEGMENT
    RSGH = INT(VARSEG(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENT

    ROFL = VARPTR(RAWKEY) AND &HFF 'LOAD LOW "BYTE" OFFSET
    ROFH = INT(VARPTR(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSET
    
    KSGL = VARSEG(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" SEGMENT
    KSGH = INT(VARSEG(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENT

    KOFL = VARPTR(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" OFFSET
    KOFH = INT(VARPTR(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSET

    'THIS IS THE ISR.  IT READS A SCANCODE FROM THE KEYBOARD BUFFER
    'AND RESETS IT.  THE BEST PART IS, BIOS CAN'T TOUCH IT!

    ASM = ""
    ASM = ASM + CHR$(&H52)                          'PUSH DX
    ASM = ASM + CHR$(&H51)                          'PUSH CX
    ASM = ASM + CHR$(&H53)                          'PUSH BX
    ASM = ASM + CHR$(&H50)                          'PUSH AX
    ASM = ASM + CHR$(&H6)                           'PUSH ES
    ASM = ASM + CHR$(&H57)                          'PUSH DI
    ASM = ASM + CHR$(&H1E)                          'PUSH DS
    ASM = ASM + CHR$(&H56)                          'PUSH SI
    ASM = ASM + CHR$(&HFB)                          'STI
    ASM = ASM + CHR$(&HBA) + CHR$(&H60) + CHR$(&H0) 'MOV DX,0060
    ASM = ASM + CHR$(&HEC)                          'IN AL,DX
    ASM = ASM + CHR$(&H30) + CHR$(&HE4)             'XOR AH,AH
    ASM = ASM + CHR$(&HBA) + CHR$(RSGL) + CHR$(RSGH)'MOV DX,SEG RAWKEY
    ASM = ASM + CHR$(&H8E) + CHR$(&HDA)             'MOV DS,DX
    ASM = ASM + CHR$(&HBE) + CHR$(ROFL) + CHR$(ROFH)'MOV SI,OFFSET RAWKEY
    ASM = ASM + CHR$(&H88) + CHR$(&H4)              'MOV [SI],AL
    ASM = ASM + CHR$(&H50)                          'PUSH AX
    ASM = ASM + CHR$(&HBA) + CHR$(&H61) + CHR$(&H0) 'MOV DX,0061
    ASM = ASM + CHR$(&HEC)                          'IN AL,DX
    ASM = ASM + CHR$(&HC) + CHR$(&H82)              'OR AL,82
    ASM = ASM + CHR$(&HEE)                          'OUT DX,AL
    ASM = ASM + CHR$(&H24) + CHR$(&H7F)             'AND AL,7F
    ASM = ASM + CHR$(&HEE)                          'OUT DX,AL
    ASM = ASM + CHR$(&HB0) + CHR$(&H20)             'MOV AL,20
    ASM = ASM + CHR$(&HBA) + CHR$(&H20) + CHR$(&H0) 'MOV DX,0020
    ASM = ASM + CHR$(&HEE)                          'OUT DX,AL
    ASM = ASM + CHR$(&HBA) + CHR$(KSGL) + CHR$(KSGH)'MOV DX,SEG KEY.TABLE
    ASM = ASM + CHR$(&H8E) + CHR$(&HDA)             'MOV DS,DX
    ASM = ASM + CHR$(&HBE) + CHR$(KOFL) + CHR$(KOFH)'MOV SI,OFFSET KEY.TABLE
    ASM = ASM + CHR$(&H58)                          'POP AX
    ASM = ASM + CHR$(&HBB) + CHR$(&H1) + CHR$(&H0)  'MOV BX,0001--MAKE
    ASM = ASM + CHR$(&HB4) + CHR$(&H48)             'MOV AH,48--UP
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H50)             'MOV AH,50--DOWN
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H4B)             'MOV AH,4B--LEFT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H4D)             'MOV AH,4D--RIGHT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H1D)             'MOV AH,1D--CTRL
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H38)             'MOV AH,38--ALT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H39)             'MOV AH,39--SPACE
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H1)              'MOV AH,01--ESC
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H1C)             'MOV AH,1C--ENTER
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H36)             'MOV AH,36--RSHIFT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BX

    ASM = ASM + CHR$(&HBB) + CHR$(&H0) + CHR$(&H0)  'MOV BX,0000--BREAK
    ASM = ASM + CHR$(&HB4) + CHR$(&HC8)             'MOV AH,C8--UP
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&HD0)             'MOV AH,D0--DOWN
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&HCB)             'MOV AH,CB--LEFT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&HCD)             'MOV AH,CD--RIGHT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H9D)             'MOV AH,9D--CTRL
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&HB8)             'MOV AH,B8--ALT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&HB9)             'MOV AH,B9--SPACE
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H81)             'MOV AH,81--ESC
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&H9C)             'MOV AH,9C--ENTER
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BX
    ASM = ASM + CHR$(&HB4) + CHR$(&HB6)             'MOV AH,B6--RSHIFT
    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,AL
    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ
    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BX

    ASM = ASM + CHR$(&HFA)                          'CLI
    ASM = ASM + CHR$(&H5E)                          'POP SI
    ASM = ASM + CHR$(&H1F)                          'POP DS
    ASM = ASM + CHR$(&H5F)                          'POP DI
    ASM = ASM + CHR$(&H7)                           'POP ES
    ASM = ASM + CHR$(&H58)                          'POP AX
    ASM = ASM + CHR$(&H5B)                          'POP BX
    ASM = ASM + CHR$(&H59)                          'POP CX
    ASM = ASM + CHR$(&H5A)                          'POP DX
    ASM = ASM + CHR$(&HCF)                          'IRET

    BYTE = CHR$(INP(&H21)) 'LOAD IRQ ENABLE REGISTER IN PIC

    OUT &H21, (ASC(BYTE) AND (255 XOR 2)) 'CLEAR BIT 2 (IRQ 1)

    CALL GETVECT(OLDSEG, OLDOFF, &H9) 'LOAD OLD ISR
    CALL SETVECT(VARSEG(ASM), SADD(ASM), &H9) 'STORE NEW ISR
END SUB

SUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)
    CALL SETVECT(OLDSEG, OLDOFF, &H9) 'RESTORE OLD ISR
END SUB

SUB maketables

' Peters boring _yawn_ table creation
FOR tmp1% = 0 TO 360
  st%(tmp1%) = SIN(tmp1% * .0174) * 100
  'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";
  'NEXT tmp1%
  'FOR tmp1% = 0 TO 360
  ct%(tmp1%) = COS(tmp1% * .0174) * 100
  'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";
NEXT tmp1%

END SUB

SUB makeworld

PRINT "If you would like to load a file made with QB Raycast Level Builder, then type"
PRINT "it's file name below.  If not, just hit enter to view the default level."
PRINT
LINE INPUT "Level Filename (No extension!): ", file$
IF file$ = "" THEN GOTO Default
OPEN file$ + ".lev" FOR INPUT AS #1
FOR Y = 1 TO 12
  FOR X = 1 TO 12
    INPUT #1, Num
    Grid(X, Y) = Num
  NEXT
NEXT
EXIT SUB


Default:
' Read in this level's data
FOR j = 1 TO 12
  FOR I = 1 TO 12
    READ Grid(I, j)
  NEXT I
NEXT j

' Peter Coopers demonstration level. Change it if you wish! Each number
' is a color number
'a$(1) = "1919191919"
'a$(2) = "9000000001"
'a$(3) = "1000000409"
'a$(4) = "9010005001"
'a$(5) = "1020040009"
'a$(6) = "9030000001"
'a$(7) = "1000078009"
'a$(8) = "9050087001"
'a$(9) = "1060000009"
'a$(10) = "9191919191"

END SUB

SUB screensetup

SCREEN 7
LOCATE 4
PRINT "     RAYCASTER DEMO"
PRINT
PRINT "      UP ARROW........Move Forward"
PRINT "      DOWN ARROW......Move Backward"
PRINT "      RIGHT ARROW.....Turn Right"
PRINT "      LEFT ARROW......Turn Left"

SCREEN 7, , 2, 0

CLS
'WINDOW SCREEN (1, 1)-(320, 200)

' Sky
LINE (0, 0)-(300, 99), 3, BF

FOR cnt = 1 TO 10 ' Clouds
  a = INT(RND * 319)
  b = INT(RND * 80 + 10)
  c = INT(RND * 50)
  d = INT(RND * 10): d = d / 100
  CIRCLE (a, b), c, 1, , , d: PAINT (a, b), 1
  CIRCLE (a, b), c, 15, , , d: PAINT (a, b), 15
NEXT cnt
LINE (301, 0)-(319, 199), 0, BF ' Erase clouds on right

' Obelisk
'LINE (200, 20)-(240, 99), 0, BF
'LINE (201, 21)-(239, 98), 8, BF

LINE (200, 20)-(220, 15), 8 ' Building (gray)
LINE (220, 15)-(240, 20), 8
LINE (200, 20)-(200, 99), 8
LINE (240, 20)-(240, 99), 8
LINE (200, 99)-(240, 99), 8
PAINT (220, 50), 8
FOR cnt = 1 TO 20 ' Lights
  PSET (INT(RND * 38 + 201), INT(RND * 80 + 20)), 14
NEXT cnt
LINE (200, 20)-(220, 15), 0 ' Building (border)
LINE (220, 15)-(240, 20), 0
LINE (219, 15)-(219, 99), 0
LINE (200, 20)-(200, 99), 0
LINE (240, 20)-(240, 99), 0

' Sun
CIRCLE (50, 30), 10, 14: PAINT (50, 30), 14, 14

PCOPY 2, 3

FOR Y% = 100 TO 199
  FOR X% = 0 TO 300
    IF RND > .5 THEN c% = 8 ELSE c% = 0
    PSET (X%, Y%), c%
  NEXT X%
NEXT Y%

SCREEN 7, , 3, 0
FOR Y% = 100 TO 199
  FOR X% = 0 TO 300
    IF RND > .5 THEN c% = 8 ELSE c% = 0
    PSET (X%, Y%), c%
  NEXT X%
NEXT Y%

SCREEN 7, , 0, 1

END SUB

SUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)

    'SETVECT CHANGES THE ADDRESSES IN THE INTERRUPT VECTOR TABLE
    'TO POINT TO NEW FUNCTIONS

    STATIC ASM AS STRING 'HOLDS THE SETVECT FUNCTION
    STATIC INI AS INTEGER 'USED TO TEST WHETHER OR NOT FUNCTION HAS PREVOUSLY
                          'BEEN CALLED
    IF INI = 0 THEN

        'CREATE FUNCTION IF NOT ALREADY CREATED

        ASM = ""
        ASM = ASM + CHR$(&H55)                          'PUSH BP
        ASM = ASM + CHR$(&H89) + CHR$(&HE5)             'MOV BP,SP
        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]
        ASM = ASM + CHR$(&H8B) + CHR$(&H17)             'MOV DX,[BX]
        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]
        ASM = ASM + CHR$(&H8A) + CHR$(&H7)              'MOV AL,[BX]
        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0A]
        ASM = ASM + CHR$(&H1E)                          'PUSH DS
        ASM = ASM + CHR$(&H8E) + CHR$(&H1F)             'MOV DS,[BX]
        ASM = ASM + CHR$(&HB4) + CHR$(&H25)             'MOV AH,25
        ASM = ASM + CHR$(&HCD) + CHR$(&H21)             'INT 21
        ASM = ASM + CHR$(&H1F)                          'POP DS
        ASM = ASM + CHR$(&H5D)                          'POP BP
        ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'RETF 0006
        INI = 1 'FLAG CREATION
    END IF
    DEF SEG = VARSEG(ASM)
    CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN SETVECT
END SUB
'----------------------------------end of 3dengine.bas---------------------------------------------------


'3dlevels.bas:
'----------------------------------------------------------------------------
'======================================
'     QB Raycast Level Builder v.1
'======================================
'I was having a good time screwing around with that raycast demo and thought
'it would be cool if there was an easy way to make new levels for it. So I
'throw this crap together. It's real simple to use. The arrow keys control the
'red cursor on the grid, and hitting spacebar plots a block on the grid. To
'select a new color for the blocks, just hit 'c'. Hit 's' to save, and don't
'save with an extension. It will automatically be '*.lev'. Umm... Oh, the
'levels will not load probably into 3dengine.bas unless you have a border all
'the way around the grid... so... enjoy!
'
'
' email = bradwagner@msn.com

DECLARE SUB Cursor (Col%)
COMMON SHARED X%, Y%
SCREEN 7, 0, 0, 0
LINE (0, 0)-(319, 199), 1, B
LOCATE 2, 9
COLOR 15
PRINT "QB Raycast Level Builder"
LINE (0, 22)-(319, 22), 1

FOR X% = 10 TO 120 STEP 10
  FOR Y% = 50 TO 160 STEP 10
    LINE (X%, Y%)-(X% + 10, Y% + 10), 1, B
  NEXT
NEXT

LINE (189, 50)-(309, 170), 1, B
PAINT (190, 51), 15, 1

X% = 1
Y% = 1
c% = 9

Main:
COLOR 15
LOCATE 5, 2
PRINT STR$(X%) + "," + STR$(Y%) + " "
Cursor 12
LOCATE 23, 3
COLOR c%
PRINT "Color        "
LINE (200, 75)-(200, 155), 0
LINE -(280, 160), 0
LINE -(280, 80), 0
LINE -(200, 75), 0
LINE (200, 75)-(220, 60), 0
LINE (280, 80)-(300, 65), 0
LINE (280, 160)-(300, 145), 0
LINE (220, 60)-(300, 65), 0
LINE -(300, 145), 0
PAINT (205, 80), c%, 0
PAINT (210, 70), c%, 0
PAINT (295, 90), c%, 0
DO
  A$ = INKEY$
  A$ = UCASE$(A$)
  IF A$ = CHR$(27) THEN
    CLS
    SYSTEM
  END IF
  IF A$ = CHR$(0) + CHR$(77) AND X% < 12 THEN
    Cursor 1
    X% = X% + 1
    GOTO Main
  END IF
  IF A$ = CHR$(0) + CHR$(75) AND X% > 1 THEN
    Cursor 1
    X% = X% - 1
    GOTO Main
  END IF
  IF A$ = CHR$(0) + CHR$(80) AND Y% < 12 THEN
    Cursor 1
    Y% = Y% + 1
    GOTO Main
  END IF
  IF A$ = CHR$(0) + CHR$(72) AND Y% > 1 THEN
    Cursor 1
    Y% = Y% - 1
    GOTO Main
  END IF
  IF A$ = CHR$(32) THEN
    LINE (X% * 10 + 1, 40 + (Y% * 10) + 1)-(10 + (X% * 10) - 1, 50 + (Y% * 10) - 1), c%, BF
  END IF
  IF A$ = CHR$(13) THEN
    LINE (X% * 10 + 1, 40 + (Y% * 10) + 1)-(10 + (X% * 10) - 1, 50 + (Y% * 10) - 1), 0, BF
  END IF
  IF A$ = "C" THEN
PickColor:
    LOCATE 23, 3
    INPUT "New Color: ", c%
    IF c% < 1 OR c% > 15 THEN GOTO PickColor
    GOTO Main
  END IF
  IF A$ = "S" THEN
    LOCATE 5, 10
    LINE INPUT "Save As (No ext.): ", save$
    LOCATE 5, 10
    PRINT STRING$(28, 32);
    OPEN save$ + ".lev" FOR OUTPUT AS #1
    FOR SaveX% = 10 TO 120 STEP 10
      FOR SaveY% = 50 TO 160 STEP 10
        PRINT #1, POINT(SaveX% + 1, SaveY% + 1);
      NEXT
      PRINT #1,
    NEXT
    GOTO Main
  END IF
LOOP

SUB Cursor (Col%)
LINE (X% * 10, 40 + (Y% * 10))-(10 + (X% * 10), 50 + (Y% * 10)), Col%, B
END SUB

'----------------------------------end of 3dlevels.bas---------------------------------------------------