GET/PUT

 BBS: Inland Empire Archive
Date: 02-16-93 (19:56)             Number: 281
From: NOT STEVE                    Refer#: NONE
  To: CALVIN FRENCH                 Recvd: NO  
Subj: GET/PUT                        Conf: (2) Quik_Bas

DEFINT A-Z
'$DYNAMIC
'Must load appropriate *.QLB i.e. QB.QLB/QBX.QLB/VBDOS.QLB
' BUT _DO NOT_ use '$INCLUDE: 'whatever.BI"!!!!
'Following declare statement modified from appropriate *.bi...
DECLARE SUB Absolute (address AS INTEGER)
DECLARE SUB DoScreen ()
DECLARE SUB BlockMove ()
DECLARE SUB MakeAMask (PixArray%(), MaskArray%())
DIM SHARED StartX%, StartY%, EndX%, EndY%
'$STATIC
DIM SHARED DisableInt%, EnableInt%
DIM SHARED BackArray%(0 TO 400)
DIM SHARED SpriteArray%(0 TO 400), MaskArray%(0 TO 400)
'$DYNAMIC
REDIM SHARED ScreenArray%(0 TO 32766)
CONST C$ = "Recreated 02/15/92 by Steve Gartrell."
DisableInt% = &HCBFA   '= CLI RETF
EnableInt% = &HCBFB    '= STI RETF
SCREEN 13
DoScreen
StartX% = 159: StartY% = 100
ToggleY% = 1
ToggleX% = -1
DO
  StartY% = StartY% + ToggleY%
  IF StartY% < 1 OR StartY% > 170 THEN
    ToggleY% = -ToggleY%
  END IF
  StartX% = StartX% + ToggleX%
  IF StartX% < 1 OR StartX% > 290 THEN
    ToggleX% = -ToggleX%
  END IF
  BlockMove
LOOP UNTIL LEN(INKEY$)
SCREEN 0
WIDTH 80
COLOR 7, 0
END    'Th-th-th-ats all, folks!!!
REM $STATIC
SUB BlockMove ()
  DIM RowCnt%, NumCols%, NumRows%, ByteCnt%, CellCnt%
  DIM SourceAddr&, SourceRowOffset&, EndColAddr&
  NumCols% = (SpriteArray%(0) \ 8) - 1
  SourceRowOffset& = (320& * StartY%) + StartX% + 4
  ByteCnt% = -1
  CellCnt% = 1
  DEF SEG = VARSEG(ScreenArray%(0))
  FOR RowCnt% = 1 TO SpriteArray%(1)
    EndColAddr& = SourceRowOffset& + NumCols%
    FOR SourceAddr& = SourceRowOffset& TO EndColAddr&
      ByteCnt% = ByteCnt% + 1
      IF (ByteCnt% AND 1) THEN
        'High byte at high address!!
        POKE 1, PEEK(SourceAddr&)
        CellCnt% = CellCnt% + 1
        BackArray%(CellCnt%) = (ScreenArray%(0) AND
MaskArray%(CellCnt%)) OR SpriteArray%(CellCnt%)
      ELSE
        'Low byte at low address!!
        POKE 0, PEEK(SourceAddr&)
      END IF
    NEXT
    SourceRowOffset& = SourceRowOffset& + 320
  NEXT
  DEF SEG
  IF (ByteCnt% AND 1) = 0 THEN
    BackArray%(CellCnt% + 1) = (ScreenArray%(0) AND MaskArray%(CellCnt% + 1))
OR SpriteArray%(CellCnt% + 1)
  END IF
  CALL Absolute(VARPTR(DisableInt%))
  WAIT &H3DA, 8, 8
  WAIT &H3DA, 8
  PUT (StartX%, StartY%), BackArray%, PSET
  CALL Absolute(VARPTR(EnableInt%))
END SUB
SUB DoScreen ()
  DIM X%, Y%
  CLS
  CIRCLE (165, 100), 9, 4
  PAINT (165, 100), 90, 4
  CIRCLE (165, 100), 8, 4, 0, 3.14
  CIRCLE (165, 100), 9, 90, 3.14, 6.28
  CIRCLE (162, 99), 3, 1
  PAINT (162, 99), 0, 1
  CIRCLE (168, 99), 3, 1
  PAINT (168, 99), 0, 1
  CIRCLE (165, 103), 3, 1, 3.43, 5.83
  StartX% = 154: StartY% = 89: EndX% = 176: EndY% = 111
  REDIM ScreenArray%(0 TO 32002)  'whole screen 13 = 32002
  REDIM PixArray%(StartY% TO EndY%, StartX% TO EndX%)
  FOR Y% = StartY% TO EndY%
    FOR X% = StartX% TO EndX%
      PixArray%(Y%, X%) = POINT(X%, Y%)
    NEXT
  NEXT
  GET (StartX%, StartY%)-(EndX%, EndY%), SpriteArray%
  BackArray%(0) = SpriteArray%(0): MaskArray%(0) = SpriteArray%(0)
  BackArray%(1) = SpriteArray%(1): MaskArray%(1) = SpriteArray%(1)
  MakeAMask PixArray%(), MaskArray%()
  CLS
  b% = 16
  FOR a% = 0 TO 319
    LINE (a%, 0)-(a%, 199), b%
    b% = b% + 1
    IF b% > 143 THEN b% = 16
  NEXT
  'memory hog!!!  But necessary...
  GET (0, 0)-(319, 199), ScreenArray%(0)
END SUB
SUB MakeAMask (PixArray%(), MaskArray%())
  DIM ByteCnt%, CellCnt%, X%, Y%
  CellCnt% = 2
  ByteCnt% = 0
  FOR Y% = StartY% TO EndY%
    FOR X% = StartX% TO EndX%
      IF ByteCnt% AND 1 THEN
        IF PixArray%(Y%, X%) = 0 THEN
          MaskArray%(CellCnt%) = MaskArray%(CellCnt%) OR -256
        END IF
        CellCnt% = CellCnt% + 1
      ELSE
        IF PixArray%(Y%, X%) = 0 THEN
          MaskArray%(CellCnt%) = MaskArray%(CellCnt%) OR 255
        END IF
      END IF
      ByteCnt% = ByteCnt% + 1
    NEXT
  NEXT
END SUB

$$
 * Origin: JW-PC Consulting DataFlex.HST (608)837-1923 (1:121/8)