'===========================================================================
' Subject: IMAGE MAGNIFICATION               Date: 04-18-97 (09:45)       
' Author:  Nick Cangiani                     Code: QB, QBasic, PDS        
' Origin:  gcnc@worldnet.att.net           Packet: GRAPHICS.ABC
'===========================================================================
'This program uses simple scaling algorithms to create a "magnifying glass"
'effect.  Two windows scroll randomly over a 320x200x256 PCX file.  One uses
'a factor of 2, the other a factor of 4.  This program could be a LOT more
'efficient, the flicker could be reduced, etc, but I wrote it while taking a
'break from studying.
'
'
'-Nick Cangiani
' gcnc@worldnet.att.net
'
'
'$DYNAMIC
CONST FALSE = 0, TRUE = 1
CONST pi = 3.141, twopi = 6.283
DECLARE SUB FillWindow (X%, Y%)
DECLARE SUB FillWindow1 (X%, Y%)
DECLARE SUB PCXLoad (PCXFile$, PaletteLoad%)

DIM SHARED c%(99)   'this will hold the bottom area being viewed
DIM SHARED A%(399)   'this will hold the area being viewed for the top
q = 4 + INT((40 - 1 + 1) * (8 + 7) / 8) * 1 * (40 - 1 + 1)
DIM B%(q)     'this will be used with GET and PUT to store old screen data
DIM d%(q)

CLS
PRINT "Magnifying Glass Demo"
PRINT "  by: Nick Cangiani"
PRINT "      gcnc@worldnet.att.net"
PRINT
PRINT "Enter the name of a 320x200 256 color PCX file."
INPUT ">", PCXFile$
PRINT "Do you want to load the palette? (y/n)"
INPUT ">", p$
IF UCASE$(p$) = "Y" THEN pa% = 1 ELSE pa% = 0
SCREEN 13
PCXLoad PCXFile$, pa%

WinX% = 1: WinY% = 1             'initial values for window
t% = 0                           'index for A%()
Dir% = 6: Dir1% = 2              'initial direction
WinX1% = 1: WinY1% = 104
GET (WinX%, WinY%)-(WinX% + 39, WinY% + 39), B%(0)
FOR Y% = WinY% + 11 TO WinY% + 30  'cover whole 20x20 section
  FOR X% = WinX% + 11 TO WinX% + 30
    A%(t%) = POINT(X%, Y%)         'store entire window in array
    t% = t% + 1
  NEXT X%
NEXT Y%
t% = 0
GET (WinX1%, WinY1%)-(WinX% + 39, WinY% + 39), d%(0)
FOR Y% = WinY1% + 16 TO WinY1% + 25  'cover whole 20x20 section
  FOR X% = WinX1% + 16 TO WinX1% + 25
    c%(t%) = POINT(X%, Y%)         'store entire window in array
    t% = t% + 1
  NEXT X%
NEXT Y%


FillWindow WinX%, WinY%    'fill view window
FillWindow1 WinX1%, WinY1%

'main loop
DO

cnt% = cnt% + 1                       'increase counter
cnt1% = cnt1% + 1
d! = TIMER                            'Delay - I am working with a 486/66
DO                                    '     adjust to fit your system
LOOP UNTIL TIMER > d! + .01
LastX% = WinX%: LastY% = WinY%        'store old area coordinates
LastX1% = WinX1%: LastY1% = WinY1%
IF cnt% = 33 THEN                     'change direction
cnt% = 0
11 RANDOMIZE TIMER
  Dir% = INT((9 - 1 + 1) * RND + 1)
END IF

IF cnt1% = 45 THEN
cnt1% = 0
12 RANDOMIZE TIMER
  Dir1% = INT((9 - 1 + 1) * RND + 1)
END IF

IF Dir% = 7 OR Dir% = 8 OR Dir% = 9 THEN    'All the collision detection crap
  IF WinY% - 1 < 1 THEN GOTO 11
  WinY% = WinY% - 1
END IF
IF Dir% = 1 OR Dir% = 2 OR Dir% = 3 THEN
  IF WinY% + 1 > 60 THEN GOTO 11  '60
  WinY% = WinY% + 1
END IF
IF Dir% = 7 OR Dir% = 4 OR Dir% = 1 THEN
  IF WinX% - 1 < 1 THEN GOTO 11
  WinX% = WinX% - 1
END IF
IF Dir% = 9 OR Dir% = 6 OR Dir% = 1 THEN
  IF WinX% + 1 > 280 THEN GOTO 11
  WinX% = WinX% + 1
END IF

IF Dir1% = 7 OR Dir1% = 8 OR Dir1% = 9 THEN
  IF WinY1% - 1 < 101 THEN GOTO 12    '1
  WinY1% = WinY1% - 1
END IF
IF Dir1% = 1 OR Dir1% = 2 OR Dir1% = 3 THEN
  IF WinY1% + 1 > 160 THEN GOTO 12
  WinY1% = WinY1% + 1
END IF
IF Dir1% = 7 OR Dir1% = 4 OR Dir1% = 1 THEN
  IF WinX1% - 1 < 1 THEN GOTO 12
  WinX1% = WinX1% - 1
END IF
IF Dir1% = 9 OR Dir1% = 6 OR Dir1% = 1 THEN
  IF WinX1% + 1 > 280 THEN GOTO 12
  WinX1% = WinX1% + 1
END IF

PUT (LastX%, LastY%), B%(0), PSET                  'put old area
GET (WinX%, WinY%)-(WinX% + 39, WinY% + 39), B%(0) 'get new are
t% = 0                                             'index at 0
FOR Y% = WinY% + 11 TO WinY% + 30  'cover whole 20x20 section
  FOR X% = WinX% + 11 TO WinX% + 30
    A%(t%) = POINT(X%, Y%)         'store entire window in array
    t% = t% + 1
  NEXT X%
NEXT Y%

FillWindow WinX%, WinY%    'fill view window

PUT (LastX1%, LastY1%), d%(0), PSET            '...and the same for #2
GET (WinX1%, WinY1%)-(WinX1% + 39, WinY1% + 39), d%(0)
t% = 0
FOR Y% = WinY1% + 16 TO WinY1% + 25  'cover whole 20x20 section
  FOR X% = WinX1% + 16 TO WinX1% + 25
    c%(t%) = POINT(X%, Y%)         'store entire window in array
    t% = t% + 1
  NEXT X%
NEXT Y%
FillWindow1 WinX1%, WinY1%

LOOP

 

REM $STATIC
SUB FillWindow (X%, Y%)
Xa% = X%: Ya% = Y%
FOR i% = 0 TO 399
  LINE (Xa%, Ya%)-(Xa% + 1, Ya% + 1), A%(i%), BF
  Xa% = Xa% + 2
  IF Xa% = 40 + X% THEN
    Xa% = X%
    Ya% = Ya% + 2
  END IF
NEXT i%

END SUB

SUB FillWindow1 (X%, Y%)
Xa% = X%: Ya% = Y%
FOR i% = 0 TO 99
  LINE (Xa%, Ya%)-(Xa% + 3, Ya% + 3), c%(i%), BF
  Xa% = Xa% + 4
  IF Xa% = 40 + X% THEN
    Xa% = X%
    Ya% = Ya% + 4
  END IF
NEXT i%

END SUB

SUB PCXLoad (PCXFile$, PaletteLoad%)
DIM buf(32002) AS INTEGER: buf(0) = 2560: buf(1) = 200
BSEG& = VARSEG(buf(2)): BOFS& = VARPTR(buf(2))
OPEN PCXFile$ FOR INPUT AS #1: CLOSE 1: OPEN PCXFile$ FOR BINARY AS #1
fin& = LOF(1) - 767: SEEK #1, fin&: pal$ = INPUT$(768, 1)
p% = 1: fin& = fin& - 1
IF PaletteLoad% = TRUE THEN
FOR t& = 0 TO 255
   OUT &H3C8, t&
   FOR hue% = 1 TO 3
      OUT &H3C9, ASC(MID$(pal$, p%)) \ 4: p% = p% + 1
   NEXT
NEXT
END IF
SEEK #1, 129: t& = BOFS&: DEF SEG = BSEG&: CLS : spin% = 1
RLE% = 0
DO
   p$ = INPUT$(256, 1): fpos& = SEEK(1): l% = LEN(p$)
   IF fpos& > fin& THEN
      l% = l% - (fpos& - fin&): p$ = LEFT$(p$, l%): view$ = "done"
   END IF
   FOR p% = 1 TO l%
      dat% = ASC(MID$(p$, p%))
      IF RLE% = 0 THEN
         IF (dat% AND 192) = 192 THEN
            RLE% = dat% AND 63
         ELSE
            POKE t&, dat%: t& = t& + 1
         END IF
      ELSE
         FOR RLE% = RLE% TO 1 STEP -1
            POKE t&, dat%: t& = t& + 1
         NEXT
      END IF
   NEXT
LOOP UNTIL view$ = "done"
bt2! = TIMER: CLOSE 1: PUT (0, 0), buf, PSET
END SUB