'===========================================================================
' Subject: USING 64K BUFFERS FOR VIDEO       Date: 12-04-97 (02:43)       
' Author:  Steven McGranahan                 Code: QB, QBasic, PDS        
' Origin:  mcgrnhns@mc.net                 Packet: GRAPHICS.ABC
'===========================================================================
'BagPage.BAS by KAOS Soft-Ware.
'This is a small demo program on using 64k buffers as video page buffers in
'screen 13. If you like these subs then please e-mail me at: mcgrnhns@mc.net
'Thanks to Jonathan Leger for memcopy and fillchar.
'KAOS Soft-Ware:
'http://user.mc.net/mcgrnhns/
DEFINT A-Z
DECLARE SUB NEWPUT (x%, y%, array%(), subscript%)
DECLARE SUB NCLS ()
DECLARE SUB COPYVPAGE ()
DECLARE SUB NPSET (x%, y%, pcolor%)
DECLARE SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
DECLARE SUB FillChar (segment%, offset%, value%, bytes%)

'$DYNAMIC '*** Hey it runns faster :)

DIM SHARED buffer(1 TO 32000) AS INTEGER

'*** Go to screen 13.
SCREEN 13
CLS
'*** first make a block 20 x 20 pixles big in buffer.
FOR y% = 0 TO 19
    FOR x% = 0 TO 19
        NPSET x%, y%, x% + y%
    NEXT
NEXT
'*** now copy that to the screen
COPYVPAGE
'*** Capture image on screen with GET
DIM array%(((20 * 20) / 2) + 2)
GET (0, 0)-(19, 19), array%
'*** now clear the buffer
NCLS
'*** now use NEWPUT to put the image on the buffer 10 times.
FOR yay% = 0 TO 9
    NEWPUT yay%, yay%, array%(), 0
NEXT
'*** copy the buffer to the screen then clear the buffer
COPYVPAGE
NCLS
SLEEP 0
CLS

SUB COPYVPAGE
'This sub copys the contents of the buffer into the screen.
'To use it just type COPYVPAGE
MemCopy VARSEG(buffer(1)), VARPTR(buffer(1)), &HA000, 0, &HFA00
END SUB

SUB FillChar (segment%, offset%, value%, bytes%)
'Do not use this rutien directly use NCLS insted
asm$ = ""
asm$ = asm$ + CHR$(85)                             'PUSH BP
asm$ = asm$ + CHR$(137) + CHR$(229)                'MOV BP,SP
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]
asm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8)       'MOV DX,[BP+08]
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12)      'MOV AX,[BP+0C]
asm$ = asm$ + CHR$(30)                             'PUSH DS
asm$ = asm$ + CHR$(142) + CHR$(216)                'MOV DS,AX
asm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10)      'MOV BX,[BP+0A]
asm$ = asm$ + CHR$(136) + CHR$(23)                 'MOV [BX],DL <------+
asm$ = asm$ + CHR$(67)                             'INC BX             |
asm$ = asm$ + CHR$(226) + CHR$(251)                'LOOP 0112   -------+
asm$ = asm$ + CHR$(31)                             'POP DS
asm$ = asm$ + CHR$(93)                             'POP BP
asm$ = asm$ + CHR$(203)                            'RETF

DEF SEG = VARSEG(asm$)
   CALL Absolute(BYVAL segment%, BYVAL offset%, BYVAL value%, BYVAL bytes%, SADD(asm$))
DEF SEG

END SUB

SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
'Do not use this rutien use COPYVPAGE insted.

asm$ = ""
asm$ = asm$ + CHR$(85)                             'PUSH BP
asm$ = asm$ + CHR$(137) + CHR$(229)                'MOV BP,SP
asm$ = asm$ + CHR$(30)                             'PUSH DS
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10)      'MOV AX,[BP+0A]
asm$ = asm$ + CHR$(142) + CHR$(192)                'MOV ES,AX
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14)      'MOV AX,[BP+0E]
asm$ = asm$ + CHR$(142) + CHR$(216)                'MOV DS,AX
asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8)      'MOV SI,[BP+08]
asm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12)     'MOV DI,[BP+0C]
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]
asm$ = asm$ + CHR$(243)                            'REPZ
asm$ = asm$ + CHR$(164)                            'MOVSB
asm$ = asm$ + CHR$(31)                             'POP DS
asm$ = asm$ + CHR$(93)                             'POP BP
asm$ = asm$ + CHR$(203)                            'RETF

DEF SEG = VARSEG(asm$)
   CALL Absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(asm$))
DEF SEG

END SUB

SUB NCLS
'This sub Clears the buffer to black
'Usage: NCLS
FillChar VARSEG(buffer(1)), VARPTR(buffer(1)), 0, &HFA00
END SUB

SUB NEWPUT (x%, y%, array%(), subscript%)
'Replaces PUT by puting an image to the buffer insted of directly to the screen
'Usage: NewPut x%, y%, array%(), subscript%
'x%, y%     - the position to put the sprite
'array%()   - the array that contains the sprite
'subscript% - the starting position of the sprite inside the array
xlent% = array%(subscript%) / 8
ylent% = array%(subscript% + 1)
Ptr& = VARPTR(array%(subscript% + 2))
ysize% = y% + ylent% - 1
xsize% = x% + xlent% - 1
seg1& = VARSEG(array%(subscript%))
seg2& = VARSEG(buffer(1))
FOR yp% = y% TO ysize%
    FOR xp% = x% TO xsize%
        DEF SEG = seg1&
        byte% = PEEK(Ptr&)
        DEF SEG = seg2&
        IF byte% <> 0 THEN POKE xp% + (yp% * 320&), byte%
        Ptr& = Ptr& + 1
    NEXT
NEXT
END SUB

SUB NPSET (x%, y%, pcolor%)
'Places a pixle inside the buffer
'Usage: NPSET x%, y%, pcolor%
'x%, y%  - the position of the pixle to place
'pcolor% - the color to place 
DEF SEG = VARSEG(buffer(1))
	POKE x% + (y% * 320&), pcolor%
DEF SEG
END SUB