2000-07-10 11:51

'This is the Erland Rovik's porting to RapidQ of the Peter Cooper's QB Raytracer.
'I simply put it to work. Finally it behaves more or less as Peter's original
'It's the simplest one in the ABC packets, so donŽt expect textures and things
'It uses DirectX so it will not work in Linux
'The keys are  Z for left, X for right and space to go forward
'You will have a black window until you press the first key.
'Enjoy!
'Antoni Gual  agual@eic.ictnet.es

     DECLARE SUB raytrace
     DECLARE SUB key(key AS BYTE)
     DECLARE SUB paint
     DECLARE SUB size

     DIM st%(0 TO 360) AS INTEGER
     DIM ct%(0 TO 360) AS INTEGER
     DIM a$(1 TO 10) AS STRING
     DIM QBclrs(0 TO 15) AS LONG
     DIM sa% AS INTEGER,tmp1% AS INTEGER,px% AS INTEGER,py% AS INTEGER,t% AS INTEGER
     DIM xb AS INTEGER,yb AS INTEGER,bx AS INTEGER,by AS INTEGER,l% AS INTEGER,k% AS INTEGER
     DIM x% AS INTEGER,dd% AS INTEGER


     QBclrs(0) =0
     QBclrs(1) =&H800000
     QBclrs(2) =&H008000
     QBclrs(3) =&H808000
     qbclrs(4) =&h000080
     qbclrs(5) =&H800080
     qbclrs(6) =&h808000
     qbclrs(7) =&h808080  'don't use this one
     qbclrs(8) =&h404040  'don't use this one
     qbclrs(9) =&hff0000
     qbclrs(10)=&H00FF00
     qbclrs(11)=&H00FFFF
     qbclrs(12)=&HFF0000
     qbclrs(13)=&Hff00FF
     qbclrs(14)=&HffFF00
     qbclrs(15)=&HffFFff

'maze defs
     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"
'TRIGONOMETRIC TABLES
     FOR tmp1% = 0 TO 360
      st%(tmp1%) = (SIN(tmp1% * .0174)) * 100
     NEXT tmp1%
     FOR tmp1% = 0 TO 360
      ct%(tmp1%) = (COS(tmp1% * .0174)) * 100
     NEXT tmp1%

     px% = 15: py% = 15: sa% = 0
     CREATE tim AS QTIMER					'this paints the first frame, before user hits any key
      interval=1000
      ontimer=raytrace
     END CREATE
     CREATE form AS QFORM
      clientheight=200
      clientwidth=300
      center
      CREATE can AS QDXSCREEN
       width=form.clientwidth
       height=form.clientheight
      END CREATE
      onkeypress=key
     END CREATE

     SUB key(key AS BYTE)
      SELECT CASE CHR$(key)
      CASE "x":sa% = sa% + 3
      CASE "z":sa% = (sa% + 357) MOD 360
      CASE " "
       px% = px% + (st%(t% MOD 360) / 50)
       py% = py% + (ct%(t% MOD 360) / 50)
      CASE ELSE
       EXIT SUB
      END SELECT
      raytrace
     END SUB

     SUB raytrace
      can.fill(qbclrs(15))
      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
       LOOP UNTIL k%
       x%=(t%-sa%)*5
       dd%=(1000/l%)
       can.fillrect x%,100-dd%,x%+5,100+dd%,qbclrs(k%)
       can.LINE x%,100-dd%,x%+5,100-dd%,0
       can.LINE x%,100+dd%,x%+5,100+dd%,0
      NEXT t%
      can.flip
     END SUB
     tim.enabled=1
     form.SHOWMODAL

2000-07-10 11:51