' This is a simple "plasma" display in VGA mode 13h. It's based on several
' PD versions, most notably Alex Chalfins Pascal plasma.
'
' This version could use some speeding up, it takes 60 seconds to run
' on my 386/33. This is the slowest I have, the Pascal takes 44 seconds,
' the C takes 15 second and the champ is the version in Fractint, which
' takes only 8.5 seconds. Something to shoot for anyway.
'
' The main subroutines are Splitbox and Newcolor. I don't see any obvious
' speed ups, but maybe someone else...?
'
' Fractal plasmas are made by continually subdividing the screen into
' smaller and smaller boxes. The corners of each box is given a color
' based on the color of the other corners plus a random value.
'
' released to public domain, no rights reserved or wanted.
' Mark Phillips
' Cserve 73167,3216

$OPTIMIZE SPEED
$FLOAT PROCEDURE 'use fast math
$LIB ALL OFF 'you don't need any

DEFINT a - z

Max.x = 319
Max.y = 199 'screen size
Max.color = 255 'number of colors to use
Rough! = 2 'how "rough" you want the plasma to be.

TYPE RGBType
  R AS BYTE
  G AS BYTE
  B AS BYTE
END TYPE

DIM PAL(512) AS RGBType

SHARED Max.x, Max.y, Rough!, Max.color, pal()

EXIT FAR AT Finish

IF ISFALSE IsVGA% THEN PRINT "No VGA found": END

RANDOMIZE TIMER

Mode13Set

MakePalette 'build a smooth palette

Set13pixel 0, 0,(RND * Max.color) + 1 'set the corners
Set13pixel 0, Max.Y,(RND * Max.color) + 1
Set13pixel Max.x, 0,(RND * Max.color) + 1
Set13pixel Max.x, Max.Y,(RND * Max.color) + 1

'use Set13Pixel to plant "seed" pixels here, if wanted

t# = TIMER
Splitbox 0, 0, Max.x, Max.y
t# = TIMER - t#

ropal 'rotate the palette

finish:
textmode
CLS
PRINT t#
END



SUB Splitbox(x1, y1, x2, y2) 'this is the main subroutine
                                         '
  IF (x2 - x1 < 2) AND (y2 - y1 < 2) THEN EXIT SUB
  IF INSTAT THEN EXIT FAR 'any key quits program
  x = (x1 + x2) / 2
  y = (y1 + y2) / 2
  Newcolor x1, y1, x, y1, x2, y1
  Newcolor x2, y1, x2, y, x2, y2
  Newcolor x1, y2, x, y2, x2, y2
  Newcolor x1, y1, x1, y, x1, y2
  IF get13pixel(x, y) = 0 THEN
    colour = (get13pixel(x1, y1) + get13pixel(x2, y1) + get13pixel(x2, y2) + get13pixel(x1, y2)) / 4
    IF colour < 1 THEN colour = 1
    IF colour > Max.color THEN colour = Max.color
    Set13pixel x, y, colour
  END IF
  Splitbox x1, y1, x, y
  Splitbox x, y1, x2, y
  Splitbox x, y, x2, y2
  Splitbox x1, y, x, y2
END SUB

SUB Newcolor(xa, ya, x, y, xb, yb) 'puts a new color based on average
                                          'of surrounding pixels plus a
                                          'random value
  IF get13pixel?(x, y) < > 0 THEN EXIT SUB
  avg = ABS(xa - xb) + ABS(ya - yb)
  colour = (get13pixel?(xa, ya) + get13pixel?(xb, yb)) / 2 + (RND - 0.5) * avg * rough!
  IF colour < 1 THEN colour = 1
  IF colour > Max.color THEN colour = Max.color
  Set13Pixel x, y, colour
END SUB

SUB Makepalette 'this builds a 255 smooth color palette
                     'note it does nothing with color 0
                     'I didn't want the boarder to change.
                     'this loads an array with 511 RGB values.

  FOR c? = 1 TO 63 'from red to yellow, start with one
    cn? = 63 - c?
    PAL(c?).R = 63
    PAL(c?).G = c?
    PAL(c?).B = 0
  NEXT c?
  FOR c? = 0 TO 63
    cn? = 63 - c?
    ci? = c? + 64
    PAL(ci?).R = cn? 'yellow to blue
    PAL(ci?).G = cn?
    PAL(ci?).B = c?
  NEXT c?
  FOR c? = 0 TO 63
    cn? = 63 - c?
    ci? = c? + 128
    PAL(ci?).R = 0
    PAL(ci?).G = c?
    PAL(ci?).B = 63 'blue to cyan(blue and green)
  NEXT c?
  FOR c? = 0 TO 63
    cn? = 63 - c?
    ci? = c? + 192
    PAL(ci?).R = c? 'cyan to red
    PAL(ci?).G = cn?
    PAL(ci?).B = cn?
  NEXT c?

  FOR c = 1 TO Max.color 'copy array to second half
    col? = PAL(c).R
    PAL(c + Max.color).R = col?
    col? = PAL(c).G
    PAL(c + Max.color).G = col?
    col? = PAL(c).B
    PAL(c + Max.color).B = col?
  NEXT c
  FOR x = 1 TO Max.color 'actual VGA palette setting code
    OUT &h3c8, x 'attribute   from red to yellow
    OUT &h3c9, PAL(x).R 'red?
    OUT &h3c9, PAL(x).G 'green?
    OUT &h3c9, PAL(x).B 'blue?
  NEXT x
END SUB

SUB RoPal 'this "rotates" the palette for animation
                  'rather than moving the RGB data, I build two
                  'copies, and loop through both.
  DO
    FOR i = 0 TO Max.color
      FOR x = 1 TO Max.color
        IF INSTAT THEN EXIT FAR 'any key quits program
        OUT &h3c8, x 'attribute
        OUT &h3c9, PAL(x + i).R 'red?
        OUT &h3c9, PAL(x + i).G 'green?
        OUT &h3c9, PAL(x + i).B 'blue?
      NEXT x?
    NEXT i
  LOOP 'loop until quit
END SUB

FUNCTION IsVGA% 'test for VGA
  ' Function: returns VGA status
  IsVGA% = BIT(pbvScrnCard, 5)
END FUNCTION

SUB Mode13Set 'set 320x200 256 color mode
  ! mov ax, &h13
  ! INT &h10
END SUB

SUB TextMode 'sets text mode, resets palette
  ! mov ax, 3
  ! INT &h10
END SUB


SUB Set13Pixel(BYVAL X%, BYVAL Y%, BYVAL Colr?)
  ! mov ax, &hA000
  ! mov es, ax; es = VGA graphics memory
  ! mov cx, X%
  ! mov dx, Y%
  ! mov al, Colr?
  ! xchg dl, dh; dx = y * 256
  ! mov di, dx
  ! shr di, 1
  ! shr di, 1; di = y * 64
  ! add di, dx; di = y * 320
  ! add di, cx; di = y * 320 + x, i.e. pixel address
  ! mov es: [di], al; PUT pixel IN VGA memory
END SUB

FUNCTION Get13Pixel?(BYVAL X%, BYVAL Y%)
  ! mov ax, &hA000
  ! mov es, ax; es = VGA graphics memory
  ! mov cx, X%
  ! mov dx, Y%
  ! xchg dl, dh; dx = y * 256
  ! mov di, dx
  ! shr di, 1
  ! shr di, 1; di = y * 64
  ! add di, dx; di = y * 320
  ! add di, cx; di = y * 320 + x, i.e. pixel address
  ! mov al, es: [di]; GET pixel FROM VGA memory
  ! mov FUNCTION, al
END FUNCTION