Tweaked 320x400x256 M 1/2

 BBS: Inland Empire Archive
Date: 11-19-92 (22:42)             Number: 349
From: BRETT LEVIN                  Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Tweaked 320x400x256 M 1/2      Conf: (2) Quik_Bas

     Here's my 320x400 mode code, for any and all who are intersted.  It
should work on all 100% compat. VGAs (F.L.W. <g>)..  Have Fun!

   Begin------------------------------------------
' tweakvga.bas by Brett Levin 11/13/92  (Friday the 13th! <g>)
'  (latest update 11/19/92)

'    You are free to use, destory, mangle, and pass on these routines as
' you wish.  All I ask is that if you use it in a program, please give credit
' where credit is due.  Thanks!
'
'    Try this both compiled and in the environment, and at any different
' speeds your computer supports..

'    I wrote this from a text file posted by Earl Montgomery (thanx!), and
' my VGA reference..  I took a few risks while getting this to work but
' as far as I know, it should do fine on any register-compatible VGA.
'    Just in case, though, I am not liable for any damages incurred by
' use or modification of this program..  :-)
'            Otherwise, enjoy the show!                      -Brett

DECLARE SUB BL.TweakMode ()

DEFINT A-Z
DIM Red(256), Green(256), Blue(256)

  DEF SEG = &HA000   ' VGA segment
  BL.TweakMode       ' Enter 320x400x256 mode..

' First, clear the screen of any junk...
  OUT &H3C4, 2  ' This code sets the write plane enable register to all
  OUT &H3C5, 15 ' four planes..

  'FOR q = 0 TO 31999   ' 32k per plane, 128k total = 2 pages for a 256k vga
  '  POKE q, 0          ' This'll clear the screen, but not necessary now
  'NEXT q

  ' ***** This is part I

  linecolor = 1
  FOR x = 0 TO 79
    FOR y = 0 TO 399
      POKE (y * 80) + x, linecolor
      IF linecolor = 128 THEN linecolor = 1 ELSE linecolor = linecolor + 1
    NEXT y
  NEXT x

  ' Set up the palette
  FOR a = 0 TO 63
      Red(a) = SQR(a) * 5
      Green(a) = SQR(a) * 2
      Blue(a) = SQR(a) * 1
  NEXT
  q = 64
  FOR a = 63 TO 0 STEP -1
      Red(q) = SQR(a) * 5
      Green(q) = SQR(a) * 2
      Blue(q) = SQR(a) * 1
      q = q + 1
  NEXT

  Red(129) = 50
  Blue(129) = 50
  GOSUB out.pal

  COLOR 129
  PRINT "Lava" ' Screwed up because of planar mapping, but looks cool <g>

  GOSUB rotate

  ' ***** This is part II

  ' Set up the palette
  FOR a = 0 TO 63
      Red(a) = SQR(a) * 1
      Green(a) = SQR(a) * 2
      Blue(a) = SQR(a) * 5
  NEXT
  q = 64
  FOR a = 63 TO 0 STEP -1
      Red(q) = SQR(a) * 1
      Green(q) = SQR(a) * 2
      Blue(q) = SQR(a) * 5
      q = q + 1
  NEXT
  GOSUB out.pal

  linecolor = 1
  FOR x = 0 TO 79 STEP 2
    FOR y = 0 TO 399

      POKE (y * 80) + x, linecolor
      IF linecolor > 127 THEN linecolor = 1 ELSE linecolor = linecolor + 1
    NEXT y
    FOR y = 399 TO 0 STEP -1
      POKE (y * 80) + (x + 1), linecolor
      IF linecolor > 127 THEN linecolor = 1 ELSE linecolor = linecolor + 1
    NEXT y
  NEXT x

  COLOR 129
  LOCATE 1, 1
  PRINT "Cool, huh?"

  GOSUB rotate

SCREEN 9

DO
 FOR t! = 0 TO 12.55 STEP .1
  PRINT TAB(INT(37 + 30 * SIN(t!))); "See Ya!": IF LEN(INKEY$) <> 0 THEN END
 NEXT t!
LOOP

rotate:
  DO                                  'cycle through colors
      FOR a = 127 TO 0 STEP -1
          FOR B = 0 TO 127
                  OUT &H3C7, B + 1: OUT &H3C8, B + 1
                  D = (a + B) MOD 128
                  OUT &H3C9, Red(D)
                  OUT &H3C9, Green(D)
                  OUT &H3C9, Blue(D)
          NEXT
      IF INKEY$ <> "" THEN EXIT DO
      NEXT
  LOOP
  RETURN

out.pal:
  FOR a = 0 TO 255
      OUT &H3C7, a: OUT &H3C8, a      'send colors directly for speed
      OUT &H3C9, Red(a): OUT &H3C9, Green(a): OUT &H3C9, Blue(a)
  NEXT
  RETURN

SUB BL.TweakMode
' Yes, I have taken on Rich Geldreich's sub/func naming conventions.. :-)
' (perhaps from messing around with his code so much! <g>)

SCREEN 13                  ' Set normal 320x200x256

  OUT &H3D4, 9    ' Maximum scan line/text character height
  OUT &H3D5, &H40
>>> Continued to next message

 * SLMR 2.1a * Dammit, Jim!  I'm a doctor, not a tagline!


--- WM v2.04/91-0049