'===========================================================================
' Subject: LENS EFFECT                       Date: 05-29-97 (23:32)       
' Author:  Daniel Davies                     Code: QB, QBasic, PDS        
' Origin:  ia53@rapid.co.uk                Packet: GRAPHICS.ABC
'===========================================================================
'LENS EFFECT - By Daniel Davies
'I know this routine is a bit slow, but I wrote it for using to generate
'glass spheres in a rendering engine I'm writing at the mo, when it's finished
'it'll have texture mapping, bump mapping, phong, gouraud, lambert, and flat
'shading, glass spheres, environment mapping to simulate reflection, lens
'flare, multiple light sources, coloured light sources, specular highlites
'I'll speed up this routine some time
'I'll also add support for using the mouse in Q-BASIC. I'll also give support
'for loading GIF's for backgrounds if I can find some good code for loading
'them. I may also include it in the GUI I'm writing at the moment to make
'the cursor snazier. If you can tell me where I can get a good gif loader,
'then please do. Oh yeah, I didn't write the PCX decoder, and I don't know
'who did coz I found it on a local BBS's
'If you want to use this in a programme you can but please give me credit.
'and tell me where I can get hold of a copy of this program or e-mail me a
'copy.
'E-Mail : ia53@rapid.co.uk


DECLARE SUB viewpcx (file$)
DEFINT A-R, T-Y
DEFDBL S
DEFDBL Z

TYPE coord
x AS INTEGER
y AS INTEGER
END TYPE

d% = 32
up$ = CHR$(0) + "H"
down$ = CHR$(0) + "P"
lcur$ = CHR$(0) + "K"
rcur$ = CHR$(0) + "M"
esc$ = CHR$(27)

DIM tfm(d%, d%) AS coord 'The transformation array
DIM SHARED buffer(319, 199) AS STRING * 1
m% = 7      'Magnificationfactor

r = d% / 2      'd% is the Diameter of the lens, I use 64

s = SQR(r * r - m% * m%)
y = -r
DO
        x = -r
        DO


IF x * x + y * y >= s * s THEN
                        a = x
                        b = y
                ELSE
                        z = SQR(r * r - x * x - y * y)
                        a = (x * m% / z + .5)
                        b = (y * m% / z + .5)
END IF
tfm((x + r), (y + r)).y = (b + r)
tfm((x + r), (y + r)).x = (a + r)

x = x + 1
LOOP WHILE x < r

y = y + 1
LOOP WHILE y < r



SCREEN 13
'a$ = COMMAND$
IF LTRIM$(RTRIM$(a$)) = "" THEN
  PRINT "please enter the name and path of"
  PRINT "a pcx file to use as the background"
  INPUT pcx$
  IF pcx$ = "" THEN
    FOR x% = 0 TO 319
      FOR y% = 0 TO 199
        buffer$(x%, y%) = CHR$(x% MOD 256)
      NEXT y%
    NEXT x%
  ELSE
  viewpcx pcx$
  END IF
ELSE
  viewpcx a$
END IF
FOR x% = 0 TO 319
  FOR y% = 0 TO 199
    PSET (x%, y%), ASC(buffer$(x%, y%))
  NEXT y%
NEXT x%

DO
z$ = INKEY$
IF z$ <> "" THEN
  IF z$ = up$ THEN
      ym% = ym% - 1
      IF ym% < 0 THEN ym% = 0
  END IF
  IF z$ = down$ THEN
      ym% = ym% + 1
      IF ym% > 199 - d% THEN ym% = 199 - d%
  END IF
  IF z$ = lcur$ THEN
      xm% = xm% - 1
      IF xm% < 0 THEN xm% = 0
  END IF
  IF z$ = rcur$ THEN
      xm% = xm% + 1
      IF xm% > 319 - d% THEN xm% = 319 - d%
  END IF
  IF z$ = esc$ THEN GOTO quit:
END IF

DEF SEG = &HA000
ymod& = (ym% * 320&) + xm%
FOR y% = 1 TO d% - 1
ymod& = ymod& + 320
  FOR x% = 1 TO d% - 1
    POKE x% + ymod&, ASC(buffer(tfm(x%, y%).x + xm%, tfm(x%, y%).y + ym%))
  NEXT x%
NEXT y%

LOOP

quit:
SCREEN 0
WIDTH 80
PRINT "LENS EFFECT - BY DANIEL DAVIES"
PRINT "COPYRIGHT (C) UK 1997 Daniel G. Davies"
PRINT "E-Mail - ia53@rapid.co.uk"
PRINT "if you wish to use this in a program you can but please give me credit"
PRINT "and please tell me about the program, either sending a copy of it or"
PRINT "telling me where I can get hold of it from"
PRINT "This may be a little slow but I'm going to make it faster when I get round"
PRINT "to it, which will be after I have finished my Q-Basic rendering engine"
PRINT "I'll also add support for using the mouse in Q-BASIC I'll also give support"
PRINT "for loading GIF's for backgrounds. I may also include it in the GUI I'm"
PRINT "writing at the moment to make the cursor snazier"

DEFLNG A-B, R, X-Y
DEFSNG C-Q, T-W
SUB viewpcx (file$)

DIM pcxpal AS STRING * 768, pcxversion AS STRING * 1

pcxnum = FREEFILE
OPEN file$ FOR BINARY AS #pcxnum

   GET #pcxnum, 2, pcxversion

   IF ASC(pcxversion) = 5 THEN
      GET #1, LOF(pcxnum) - 767, pcxpal

      pal = 0

      FOR p = 1 TO 768 STEP 3
         OUT &H3C8, pal
         red% = INT(ASC(MID$(pcxpal, p, 1)) / 4)
         OUT &H3C9, red%
         green% = INT(ASC(MID$(pcxpal, p + 1, 1)) / 4)
         OUT &H3C9, green%
         blue% = INT(ASC(MID$(pcxpal, p + 2, 1)) / 4)
         OUT &H3C9, blue%
         pal = pal + 1
      NEXT p

   END IF

   SEEK #pcxnum, 129

   fxsegment = VARSEG(buffer(0, 0))
   fxoffset = VARPTR(buffer(0, 0))

   datasize = 2000

   pcxdata$ = INPUT$(datasize, pcxnum)
   datacount = 1


   FOR half = 1 TO 2

      fxtotal = fxsegment + fxoffset
      DEF SEG = fxtotal

      FOR c = 0 TO 31999

         IF datacount > datasize THEN
            pcxdata$ = INPUT$(datasize, pcxnum)
            datacount = 1
         END IF

         clr = ASC(MID$(pcxdata$, datacount, 1))
         datacount = datacount + 1

         IF datacount > datasize THEN
            pcxdata$ = INPUT$(datasize, pcxnum)
            datacount = 1
         END IF
     
         IF clr > 192 THEN
            LPS = clr - 192
            clr = ASC(MID$(pcxdata$, datacount, 1))
            datacount = datacount + 1
            FOR L = LPS TO 1 STEP -1
               POKE c, clr
               c = c + 1
            NEXT L
            c = c - 1
         ELSE
        
            POKE c, clr
         END IF
      NEXT c
      fxoffset = fxoffset + &H7D0
   NEXT half

CLOSE pcxnum

DEF SEG

END SUB