'===========================================================================
' Subject: 320X400X256 MODEX (ENVIRONMENT)   Date: 06-22-96 (08:34)       
' Author:  Douglas H. Lusher                 Code: QB, PDS                
' Origin:  FidoNet QUIK_BAS Echo           Packet: GRAPHICS.ABC
'===========================================================================
'Here is code for Mode X - 320x400x256 that will run in the
'environment.

 DEFINT A-Z
 '$INCLUDE: 'QB.BI'
 DIM BitMask%(7)
 FOR Bit% = 0 TO 7: BitMask%(Bit%) = 2 ^ Bit%: NEXT
 File0$ = "C:\TEST0.S2F": File1$ = "C:\TEST1.S2F"
 CALL Set320x400mode
 CALL XPRINT(40, 0, "Hello from PAGE 0", 4, 0)
 FOR Y% = 16 TO 399
   C% = Y% \ 8 + 16
   FOR X% = 0 TO 319
     CALL PutPixel(X%, Y%, C%, 0)
   NEXT
 NEXT
 CALL XScrn2File(File0$, 0)
 CALL ShowPage(1)
 CALL XPRINT(50, 300, "Press any key.", 0, 0)
 CALL XPRINT(40, 0, "Hello from PAGE 1", 2, 1)
 FOR X% = 0 TO 319
   C% = X% \ 8 + 16
   FOR Y% = 16 TO 399
     CALL PutPixel(X%, Y%, C%, 1)
   NEXT
 NEXT
 CALL XScrn2File(File1$, 1)
 CALL ShowPage(0)
 CALL XPRINT(50, 300, "Press any key.", 0, 1)
 SLEEP 2
 DO UNTIL LEN(INKEY$)
   CALL ShowPage(1): SLEEP 2
   CALL ShowPage(0): SLEEP 2
 LOOP

 CALL ShowPage(0)
 DO
   CALL XCLS(0)
   CALL XPRINT(0, 0, "Indicate which page to restore: (0/1) ", 15, 0)
   A$ = INPUT$(1)
   SELECT CASE A$
     CASE "0": CALL XFile2Scrn(File0$, 0)
     CASE "1": CALL XFile2Scrn(File1$, 0)
     CASE CHR$(27): EXIT DO
   END SELECT
   CALL XPRINT(50, 280, "Press ESC to exit.", 0, 0)
   CALL XPRINT(50, 300, "Press any other key to continue.", 0, 0)
   A$ = INPUT$(1): IF A$ = CHR$(27) THEN EXIT DO
 LOOP

 EndIt:
 SCREEN 0: WIDTH 80
 END

 SUB DOSCloseFile (Handle%)
 DIM Register AS RegType
 Register.AX = &H3E00
 Register.BX = Handle%
 CALL Interrupt(&H21, Register, Register)
 IF Register.Flags AND 1 THEN
   SELECT CASE Register.AX
     CASE &H6: ERROR 52    'invalid handle
     CASE ELSE: ERROR 255
   END SELECT
 END IF
 END SUB

 SUB DOSCreateFile (FileName$, Handle%)
 DIM Register AS RegTypeX
 Temp$ = FileName$ + CHR$(0)
 Register.AX = &H3C00
 Register.CX = 0
 Register.DS = VARSEG(Temp$)
 Register.DX = SADD(Temp$)
 CALL InterruptX(&H21, Register, Register)
 IF Register.Flags AND 1 THEN
   SELECT CASE Register.AX
     CASE &H3: ERROR 76   'path not found
     CASE &H4: ERROR 67   'no handles available
     CASE &H5: ERROR 75   'access denied
     CASE ELSE: ERROR 255
   END SELECT
 ELSE
   Handle% = Register.AX
 END IF
 END SUB

 SUB DOSOpenFile (FileName$, Handle%)
 DIM Register AS RegTypeX
 Temp$ = FileName$ + CHR$(0)
 Register.AX = &H3D02
 Register.DS = VARSEG(Temp$)
 Register.DX = SADD(Temp$)
 CALL InterruptX(&H21, Register, Register)
 IF Register.Flags AND 1 THEN
   SELECT CASE Register.AX
     CASE &H2: ERROR 53   'file not found
     CASE &H3: ERROR 76   'path not found
     CASE &H4: ERROR 67   'no handles available
     CASE &H5: ERROR 75   'access denied
     CASE ELSE: ERROR 255
   END SELECT
 ELSE
   Handle% = Register.AX
 END IF
 END SUB

 SUB GetPixel (X%, Y%, Culler%, Page%)
 'this is code to read the color of a pixel in MODEX 320x400x256
 'this code is based on ASM code written by Michael Abrash
 '   and published in 1989 Programmer's Journal 7.1
 'by Douglas H. Lusher - June 15, 1996
 Segment% = &HA000
 IF Page% THEN Segment% = &HA800
 OUT &H3CE, 4             'select the Read Map Select Register
 OUT &H3CF, X% AND 3      'indicate the bit plane desired
 DEF SEG = Segment%
 Culler% = PEEK((Y% * 80) + (X% \ 4))
 END SUB

 SUB PutPixel (X%, Y%, Culler%, Page%)
 'this is code to write a pixel in MODEX 320x400x256
 'this code is based on ASM code written by Michael Abrash
 '   and published in 1989 Programmer's Journal 7.1
 'by Douglas H. Lusher - June 15, 1996
 SHARED BitMask%()
 Segment% = &HA000
 IF Page% THEN Segment% = &HA800
 OUT &H3C4, 2                   'select the Map Mask Register
 OUT &H3C5, BitMask%(X% AND 3)  'indicate the desired bit plane
 DEF SEG = Segment%
 POKE (Y% * 80) + (X% \ 4), Culler%
 END SUB

 SUB Set320x400mode
 'the following code sets the VGA to 320x400x256 mode
 'this is a translation from ASM code written by Michael Abrash
 '  and published in 1989 Programmer's Journal 7.1
 'by Douglas H. Lusher - June 15, 1996
 'start with basic SCREEN 13
 SCREEN 13
 'change the CPU addressing of video memory to linear (not odd/even,
 'chain, or chain 4) to allow access to all 256K of display memory.
 SCI% = &H3C4            'the Sequence Controller Index register
 MemoryMode% = 4         'memory mode register index
 OUT SCI%, MemoryMode%
 X% = INP(&H3C5)
 X% = X% AND NOT &H8     'turn off chain 4
 X% = X% OR &H4          'turn off odd/even
 OUT &H3C5, X%

 GCI% = &H3CE            'the Graphics Controller Index register
 GraphicsMode% = 5       'graphics mode register index
 OUT GCI%, GraphicsMode%
 X% = INP(&H3CF)
 X% = X% AND NOT &H10    'turn off odd/even
 OUT &H3CF, X%

 Miscellaneous% = 6      'miscellaneous register index
 OUT GCI%, Miscellaneous%
 X% = INP(&H3CF)
 X% = X% AND NOT &H2     'turn off chain
 OUT &H3CF, X%

 'clear all of video memory - setting mode 13 only cleared 64K
 'of video memory. Do this before switching the crt out of mode 13
 'so that garbage does not appear on the screen when the switch
 'is made.
 MapMask% = 2
 OUT SCI%, MapMask%
 OUT &H3C5, &HF
 DEF SEG = &HA000                      'clear page 0
 FOR Ptr% = 0 TO 31999: POKE Ptr%, 0: NEXT
 DEF SEG = &HA800                      'clear page 1
 FOR Ptr% = 0 TO 31999: POKE Ptr%, 0: NEXT

 'tweak the mode to 320x400x256 by not scanning each line twice
 CRTCI% = &H3D4          'the CRT Controller Index register
 MaxScanLine% = 9        'maximum scan line register index
 OUT CRTCI%, MaxScanLine%
 X% = INP(&H3D5)
 X% = X% AND NOT &H1F    'set max scan line = 0
 OUT &H3D5, X%

 'change CRTC scanning from doubleword mode to byte mode, allowing
 'the CRTC to scan more than 64K of video data
 Underline% = &H14       'underline location register index
 OUT CRTCI%, Underline%
 X% = INP(&H3D5)
 X% = X% AND NOT &H40    'turn off doubleword
 OUT &H3D5, X%

 ModeControl% = &H17     'mode control register index
 OUT CRTCI%, ModeControl%
 X% = INP(&H3D5)
 X% = X% OR &H40         'turn on the byte mode bit, so memory is
                         'video memory is scanned linearly, just as
                         'in modes &H10 and &H12
 OUT &H3D5, X%
 END SUB

 SUB ShowPage (Page%)
 'this code displays the specified page in MODEX - 320x400x256
 'by Douglas H. Lusher - June 16, 1996
 SELECT CASE Page%
   CASE 0              'display page 0
     OUT &H3D4, &HC: OUT &H3D5, 0
   CASE 1              'display page 1
     OUT &H3D4, &HC: OUT &H3D5, &H80
   CASE ELSE
     ERROR 5           'illegal function call
 END SELECT
 END SUB

 SUB XCLS (Page%)
 'this is code to clear the screen in MODE X - 320x400x256
 'by Douglas H. Lusher - June 16, 1996
 SHARED BitMask%()
 'turn off the screen while it is being erased
 OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% OR &H20
 Segment% = &HA000: IF Page% THEN Segment% = &HA800
 DEF SEG = Segment%
 OUT &H3C4, 2                     'select the Map Mask Register
 FOR Plane% = 0 TO 3
   OUT &H3C5, BitMask%(Plane%)    'indicate the desired bit plane
   FOR address% = 0 TO 31999: POKE address%, 0: NEXT
 NEXT
 'turn the screen back on...
 OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% AND &HDF
 END SUB

 SUB XFile2Scrn (FileName$, Page%)
 SHARED BitMask%()
 DIM Register AS RegTypeX
 Bytes% = 32000                    '(320 * 400) \ 4
 ColorRegs% = 768                  'the number of colors * 3
 Segment% = &HA000
 IF Page% THEN Segment% = &HA800
 OUT &H3C8, 0                      'blank the screen
 FOR X% = 1 TO ColorRegs%: OUT &H3C9, 0: NEXT
 CALL DOSOpenFile(FileName$, Handle%)
 Register.BX = Handle%
 Register.CX = Bytes%
 Register.DS = Segment%
 Register.DX = 0
 FOR X% = 0 TO 3
   Register.AX = &H3F00
   OUT &H3C4, 2                    'select the Map Mask Register
   OUT &H3C5, BitMask%(X%)          'indicate the bit plane to restore
   CALL InterruptX(&H21, Register, Register)
   IF Register.Flags AND 1 THEN
     SELECT CASE Register.AX
       CASE &H5: ERROR 75    'access denied
       CASE &H6: ERROR 52    'invalid handle
     END SELECT
   ELSEIF Register.AX <> Register.CX THEN
     ' incorrect number of bytes read
     ERROR 57                'device i/o error
   END IF
 NEXT
 CALL DOSCloseFile(Handle%)
 P$ = SPACE$(ColorRegs%)
 File% = FREEFILE
 OPEN FileName$ FOR BINARY AS File%
   GET File%, (LOF(File%) + 1) - ColorRegs%, P$
 CLOSE File%
 DEF SEG = VARSEG(P$): Offset% = SADD(P$)
 OUT &H3C8, 0
 FOR X% = Offset% TO Offset% + ColorRegs% - 1
   OUT &H3C9, PEEK(X%)
 NEXT
 DEF SEG
 END SUB

 SUB XPRINT (X%, Y%, Text$, Culler%, Page%)
 'this is code to print text in MODEX - 320x400x256
 'by Douglas H. Lusher - June 15, 1996
 SHARED BitMask%()

 ' 8 x 8 char box, CGA
 'CharSegment% = &HFFA6: CharOffset% = &HE
 'CharWid% = 8: CharHgt% = 8

 ' 8 x 14 char box, EGA
 CharSegment% = &HC000: CharOffset% = &H4ED5
 CharWid% = 8: CharHgt% = 14
 ' 8 x 16 char box, VGA
 'DIM Regs AS RegTypeX
 'Regs.AX = &H1130
 'Regs.BX = &H600
 'CALL InterruptX(&H10, Regs, Regs)
 'CharSegment% = Regs.ES: CharOffset% = Regs.BP
 'CharWid% = 8: CharHgt% = 16

 XX% = X% - 1
 FOR Char% = 1 TO LEN(Text$)
   XX% = XX% + CharWid%
   YY% = Y%
   Ptr% = CharHgt% * ASC(MID$(Text$, Char%, 1)) + CharOffset%
   FOR Ln% = 0 TO CharHgt% - 1
     DEF SEG = CharSegment%
     BitPattern% = PEEK(Ptr% + Ln%)
     FOR Bit% = 0 TO 7
       IF BitPattern% AND BitMask%(Bit%) THEN
         CALL PutPixel(XX% - Bit%, YY%, Culler%, Page%)
       END IF
     NEXT
     YY% = YY% + 1
   NEXT
 NEXT
 END SUB

 SUB XScrn2File (FileName$, Page%)
 DIM Register AS RegTypeX
 Bytes% = 32000               '(320 * 400) \ 4 = 30,000 bytes
 ColorRegs% = 768             'the number of colors * 3
 Segment% = &HA000
 IF Page% THEN Segment% = &HA800
 CALL DOSCreateFile(FileName$, Handle%)
 Register.BX = Handle%
 Register.CX = Bytes%
 Register.DS = Segment%
 Register.DX = 0
 FOR X% = 0 TO 3
   Register.AX = &H4000
   OUT &H3CE, 4                'select the Read Map Select Register
   OUT &H3CF, X%               'indicate the bit plane to save
   CALL InterruptX(&H21, Register, Register)
   IF Register.Flags AND 1 THEN
     SELECT CASE Register.AX
       CASE &H5: ERROR 75      'access denied
       CASE &H6: ERROR 52      'invalid handle
     END SELECT
   ELSEIF Register.AX <> Register.CX THEN
     ' incorrect number of bytes written
     ERROR 57                  'device i/o error
   END IF
 NEXT
 CALL DOSCloseFile(Handle%)
 P$ = SPACE$(ColorRegs%)
 DEF SEG = VARSEG(P$): Offset% = SADD(P$)
 OUT &H3C7, 0
 FOR X% = Offset% TO Offset% + ColorRegs% - 1
   POKE X%, INP(&H3C9)
 NEXT
 DEF SEG
 File% = FREEFILE
 OPEN FileName$ FOR BINARY AS File%
   PUT File%, LOF(File%) + 1, P$
 CLOSE File%
 END SUB