'===========================================================================
' Subject: Mode 13 page flipping              Date: 09-15-02 (  :  )       
'  Author: /\/\ | |< 3                        Code: Qbasic                 
'  Origin: jmstechcae@wrbcity.ca            Packet: DEMOS.ABC
'===========================================================================
'===========================================================================
'  Subject: Two Pages in Screen 13             Date: 09-05-02
'   Author: /\/\ | |< 3                        Code: Text, QBasic
'===========================================================================
'==============================  Read this FIRST  
==========================
'Please note: This code shall NOT be related to money in any way. This 
means
'borrowing code for a fee, buying it, selling it, and so on. This code 
is for
'free. This code can be found at www.allbasiccode.com.
'Thank you for your understanding.
'===========================================================================

'==============================  Declarations  
=============================
'  These are added when the file is saved.                          
'===========================================================================
DECLARE SUB initasm ()
DECLARE FUNCTION init% ()
DECLARE SUB copy (w%)
DECLARE SUB intx (IntN%)
DECLARE SUB emscopy (w%, froms%, fromo%, siz&)
DECLARE SUB makejunk ()
DECLARE SUB uninit ()
DECLARE SUB demo ()
'============= Variable types and reservations 
=============================
'  The code below is required.
'===========================================================================
TYPE regtypex       '
 ax AS INTEGER      '
 bx AS INTEGER      '
 cx AS INTEGER      ' System registers will be used to access
 dx AS INTEGER      ' a chunk of EMS memory.
 bp AS INTEGER      '
 si AS INTEGER      '
 di AS INTEGER      '
 flags AS INTEGER   '
 ds AS INTEGER      '
 es AS INTEGER      '
END TYPE
DIM SHARED regsx AS regtypex, handle%, icode$ 'make most often used 
variables global.
CALL demo                                     'run the demo
END                                           'and exit

SUB copy (w%)
'translate what the user wants
'Copy 64000 bytes -> 320 pixels across * 200 pixels down = 64000.                              
'Screen address for mode 13 is A000 hex.
'We want the whole screen. offset of 0 means the beginning.
CALL emscopy(w%, &HA000, 0, 64000)
END SUB

SUB demo
CALL initasm          'Load ASM code for the interrupts.
IF init% = 1 THEN     'Check to see if enough memory is free.
CALL makejunk         'self explanatory
CALL copy(0)          'Copy contents of screen to memory.
CALL copy(1)          'Copy contents of memory to screen.
CALL uninit           'Release used memory
ELSE
'Give error if free memory is unavailable.
SCREEN 0
PRINT "You need at least"; 8 * 16384&; " bytes of free expanded 
memory."
END IF
END SUB

SUB emscopy (w%, froms%, fromo%, siz&)
'w% = action.
'if w%=0 then the contents at segment froms% and offset fromo% are 
copied to EMS
'if w%=1 then the contents at segment froms% and offset fromo% are 
copied from EMS
SELECT CASE w%
CASE 0: d$ = MKL$(siz&) + CHR$(0) + MKI$(0) + MKI$(fromo%) + 
MKI$(froms%) + CHR$(1) + MKI$(handle%) + MKI$(0) + MKI$(0)
CASE 1: d$ = MKL$(siz&) + CHR$(1) + MKI$(handle%) + MKI$(0) + MKI$(0) + 
CHR$(0) + MKI$(0) + MKI$(fromo%) + MKI$(froms%)
END SELECT
regsx.ds = VARSEG(d$)
regsx.si = SADD(d$)
regsx.ax = &H5700      'Call the move memory function
CALL intx(&H67)        'load the interrupt.
END SUB

FUNCTION init%
regsx.ax = &H4300 'Function for allocating memory.
regsx.bx = 8      'Allocate 8 pages. (4 might work but I dont trust MS 
windows)
CALL intx(&H67)   'call the EMS interrupt

IF regsx.ax < &H100 THEN 'If there is no error, then
 handle% = regsx.dx      'get the handle number and
 init% = 1               'let the parent of this sub know that EMS is 
ok.
END IF
END FUNCTION

SUB initasm
d$ = 
"558BEC83EC0856571E558B5E068B47103DFFFF75041E8F47108B47123DFFFF75041E8F47"
d$ = d$ + 
"128B47088946F88B078B4F048B57068B770A8B7F0CFF771207FF77021E8F46FAFF77101F"
d$ = d$ + 
"8B6EF85BCD21558BEC8B6E02895EFC8B5E061E8F46FEFF76FA1F89078B46FC894702894F"
d$ = d$ + 
"048957065889470889770A897F0C9C8F470E068F47128B46FE8947105A1F5F5E8BE55DCA0200"
icode$ = "": FOR x% = 1 TO LEN(d$) STEP 2: icode$ = icode$ + 
CHR$(VAL("&H" + MID$(d$, x%, 2))): NEXT x%
END SUB

SUB intx (IntN%)
DIM IntCode AS STRING * 200
IntCode = icode$: DEF SEG = VARSEG(IntCode)
POKE VARPTR(IntCode) * 1& + INT(INSTR(IntCode$, CHR$(&HCD) + 
CHR$(&H21)) + 1) - 1, IntN%
CALL absolute(regsx, VARPTR(IntCode$))
DEF SEG
END SUB

SUB makejunk
SCREEN 13                        'Load graphics mode 13
PAINT (1, 1), 1                  'and do whatever screen output
LINE (1, 1)-(100, 100), 15, BF   'operation you want.
                                 'Be creative!
END SUB

SUB uninit
regsx.ax = &H4500  'Function that frees EMS memory
regsx.bx = handle% 'Handle we have been using.
CALL intx(&H67)    'Call interrupt.
END SUB