'===========================================================================
' Subject: ASSEMBLY PLASMA GENERATOR         Date: Unknown Date (00:00)   
' Author:  Rich Geldreich                    Code: QB, PDS                
' Keys:    ASSEMBLY,PLASMA,GENERATOR       Packet: GRAPHICS.ABC
'===========================================================================
'PLASMA.BAS & PLASMA.ASM
'Input graininess on command line. Valid values are 0-40.
'Try running with a graininess of 1, and zooming in on areas with
'very little overall elevation (ie. areas that are mostly the same
'color). Some very interesting "non-cloudly" patterns will show
'themselves if you look at the right areas. If you do get some wierd
'looking patterns, make sure you try color cycling with a random
'palette.
'
'Keys recognized:
'"C"        = Toggles color cycling.
'"R"        = Sets the default palette.
'"1" to "9" = Introduces random colors into the palette while color
'             cycling.
'Array keys = Moves zoom box.
'Enter      = Zooms area inside zoom box.
'Escape     = Quits.
'
DEFINT A-Z
 
DECLARE SUB SubDivide (CX1%, CY1%, CX2%, CY2%, CC1%, CC2%, CC3%, CC4%)
DECLARE SUB SetPoint (BYVAL X, BYVAL Y, BYVAL C)
DECLARE FUNCTION GetPoint (BYVAL X, BYVAL Y)
DECLARE SUB SeedRand (BYVAL NewSeed&)
DECLARE FUNCTION GetRand% (BYVAL MaxRand%)
 
TYPE StackType
    X1 AS INTEGER
    Y1 AS INTEGER
    X2 AS INTEGER
    Y2 AS INTEGER
    C1 AS INTEGER
    C2 AS INTEGER
    C3 AS INTEGER
    C4 AS INTEGER
END TYPE
 
DIM SHARED AStack(511) AS StackType
DIM SHARED Clamp(-4096 TO 4096)
DIM SHARED F&
DIM SHARED P(0 TO 40, 0 TO 40)
DIM SHARED D(0 TO 40, 0 TO 40)
DIM r(255), g(255), B(255)
 
a$ = COMMAND$
IF LEN(a$) THEN
    F& = VAL(a$)
    IF F& < 0 THEN
        F& = 0
    ELSEIF F& > 40 THEN
        F& = 40
    END IF
ELSE
    F& = 8
END IF
 
FOR a = -4096 TO 4096
    IF a < 1 THEN
        Clamp(a) = 1
    ELSEIF a > 255 THEN
        Clamp(a) = 255
    ELSE
        Clamp(a) = a
    END IF
NEXT
 
SCREEN 13
 
'Set default palette.
GOSUB PalSet
 
'Seed the psuedo-random number generator with the current time.
DEF SEG = &H40
SeedRand PEEK(&H6C) + PEEK(&H6D) * 256& + PEEK(&H6E) * 65536
'Draw plasma.
C1 = GetRand(256) + 1
C2 = GetRand(256) + 1
C3 = GetRand(256) + 1
C4 = GetRand(256) + 1
SetPoint 0, 0, C1
SetPoint 319, 0, C2
SetPoint 319, 199, C3
SetPoint 0, 199, C4
 
'Plot the starting plasma.
CALL SubDivide(0, 0, 319, 199, C1, C2, C3, C4)
 
C = 1
 
DO
    Xs = (320 - 40) \ 2
    Ys = (200 - 40) \ 2
 
    DO
        FOR a = 0 TO 41
            SetPoint Xs + a, Ys, GetPoint(Xs + a, Ys) XOR &HAA
            SetPoint Xs + a, Ys + 41, GetPoint(Xs + a, Ys + 41) XOR &HAA
            SetPoint Xs, Ys + a, GetPoint(Xs, Ys + a) XOR &HAA
            SetPoint Xs + 41, Ys + a, GetPoint(Xs + 41, Ys + a) XOR &HAA
        NEXT
 
        DO
            IF CycleOn THEN
                IF RandC > 0 THEN
                    IF GetRand(10) <= RandFreq THEN
                        r(RandC) = GetRand(64)
                        g(RandC) = GetRand(64)
                        B(RandC) = GetRand(64)
                    ELSE
                        r(RandC) = 0
                        g(RandC) = 0
                        B(RandC) = 0
                    END IF
                    RandC = RandC + 1
                    IF RandC = 256 THEN
                        RandC = 0
                    END IF
                END IF
 
                WAIT &H3DA, 8
                OUT &H3C8, 1
                D = C
                FOR a = 1 TO 255
                    OUT &H3C9, r(D)
                    OUT &H3C9, g(D)
                    B = B(D)
                    WAIT &H3DA, 1
                    OUT &H3C9, B
                    WAIT &H3DA, 1, 1
                    D = D + 1
                    IF D = 256 THEN D = 1
                NEXT
                C = C + 1
                IF C = 256 THEN C = 1
                WAIT &H3DA, 8, 8
            END IF
 
            a$ = INKEY$
        LOOP UNTIL LEN(a$)
 
        FOR a = 0 TO 41
            SetPoint Xs + a, Ys, GetPoint(Xs + a, Ys) XOR &HAA
            SetPoint Xs + a, Ys + 41, GetPoint(Xs + a, Ys + 41) XOR &HAA
            SetPoint Xs, Ys + a, GetPoint(Xs, Ys + a) XOR &HAA
            SetPoint Xs + 41, Ys + a, GetPoint(Xs + 41, Ys + a) XOR &HAA
        NEXT
 
        SELECT CASE a$
        CASE CHR$(0) + CHR$(72) 'up
            Ys = Ys - 5
            IF Ys < 0 THEN Ys = 0
        CASE CHR$(0) + CHR$(80) 'down
            Ys = Ys + 5
            IF Ys > 200 - 42 THEN Ys = 200 - 42
        CASE CHR$(0) + CHR$(77) 'right
            Xs = Xs + 5
            IF Xs > 320 - 42 THEN Xs = 320 - 42
        CASE CHR$(0) + CHR$(75)'left
            Xs = Xs - 5
            IF Xs < 0 THEN Xs = 0
        CASE CHR$(13), "0"
            EXIT DO
        CASE "C", "c"
            CycleOn = NOT CycleOn
        CASE "R", "r"
            GOSUB PalSet
            C = 1
        CASE "1" TO "9"
            RandC = 1
            RandFreq = ASC(a$) - 49
        CASE CHR$(27)
            END
        END SELECT
    LOOP
 
    L = 256
    h = 0
    FOR Y = Ys TO Ys + 40
        FOR X = Xs TO Xs + 40
            P = GetPoint(X, Y) - 1
            IF P < L THEN L = P
            IF P > h THEN h = P
            P(X - Xs, Y - Ys) = P
        NEXT
    NEXT
 
    'Maximize the scale of the new plasma to take advantage of
    'all colors- this will usually cause the zoomed plasma's colors to
    'appear different from its original colors, but must be done because
    'there are only 256 colors available.
    IF (h - L) = 0 THEN 'avoid overflow error
        Scaler& = 256
    ELSE
        Scaler& = (255 * 256&) \ (h - L)
    END IF
 
    FOR Y = 0 TO 40
        FOR X = 0 TO 40
            P = 1 + ((P(X, Y) - L) * Scaler&) \ 256
            IF P > 255 THEN P = 255
            P(X, Y) = P
        NEXT
    NEXT
 
    CLS
 
    FOR Y = 0 TO 40
        Ys = Y * 5: IF Ys > 199 THEN Ys = 199
        FOR X = 0 TO 40
            Xs = X * 8: IF Xs > 319 THEN Xs = 319
            SetPoint Xs, Ys, P(X, Y)
        NEXT
    NEXT
 
    ERASE D
 
    'Fill in the black areas.
    FOR Y = 0 TO 39
        Ys = Y * 5
        Ye = Ys + 5
        IF Ye > 199 THEN Ye = 199
        FOR X = 0 TO 39
            Xs = X * 8
            Xe = Xs + 8
            IF Xe > 319 THEN Xe = 319
            CALL SubDivide(Xs, Ys, Xe, Ye, P(X, Y), P(X + 1, Y), P(X + 1, Y + 1), P(X, Y + 1))
        NEXT
    NEXT
LOOP UNTIL a$ = CHR$(27)
END
 
PalSet:
  'Alter this section here for another palette.
  FOR a = 0 TO 63
    s = 0: r = 63: g = a: B = 0: GOSUB Set
    s = 64: r = 63 - a: g = 63: B = 0: GOSUB Set
    s = 128: r = 0: g = 63 - a: B = a: GOSUB Set
    s = 192: r = a: g = 0: B = 63: GOSUB Set
  NEXT
RETURN
 
Set:
  IF a + s = 0 THEN RETURN  'to keep the background black
  r(a + s) = r
  g(a + s) = g
  B(a + s) = B
  OUT &H3C8, a + s
  OUT &H3C9, r
  OUT &H3C9, g
  OUT &H3C9, B
RETURN
 
'This subroutine subdivides the screen into small areas
'and fills them in with psuedo-random colors. Areas close the each
'other are very similar, but as the distance increases between two
'areas they grow very different.
SUB SubDivide (CX1, CY1, CX2, CY2, CC1, CC2, CC3, CC4)
 
    sp = 0
    AStack(sp).X1 = CX1: AStack(sp).Y1 = CY1
    AStack(sp).X2 = CX2: AStack(sp).Y2 = CY2
    AStack(sp).C1 = CC1: AStack(sp).C2 = CC2
    AStack(sp).C3 = CC3: AStack(sp).C4 = CC4
    sp = sp + 1
 
    DO WHILE sp
        sp = sp - 1
        X1 = AStack(sp).X1: Y1 = AStack(sp).Y1
        X2 = AStack(sp).X2: Y2 = AStack(sp).Y2
        C1 = AStack(sp).C1: C2 = AStack(sp).C2
        C3 = AStack(sp).C3: C4 = AStack(sp).C4
Jag:
        'Find center of area.
        X = (X1 + X2) \ 2
        Y = (Y1 + Y2) \ 2
 
        CA = GetPoint(X, Y1)
        IF CA = 0 THEN
            CA = Clamp((C1 + C2) \ 2 + ((GetRand(128) - 64) * (X2 - X1) * F&) \ 256)
            SetPoint X, Y1, CA
        END IF
 
        CB = GetPoint(X2, Y)
        IF CB = 0 THEN
            CB = Clamp((C2 + C3) \ 2 + ((GetRand(128) - 64) * (Y2 - Y1) * F&) \ 256)
            SetPoint X2, Y, CB
        END IF
 
        CC = GetPoint(X, Y2)
        IF CC = 0 THEN
            CC = Clamp((C4 + C3) \ 2 + ((GetRand(128) - 64) * (X2 - X1) * F&) \ 256)
            SetPoint X, Y2, CC
        END IF
 
        CD = GetPoint(X1, Y)
        IF CD = 0 THEN
            CD = Clamp((C1 + C4) \ 2 + ((GetRand(128) - 64) * (Y2 - Y1) * F&) \ 256)
            SetPoint X1, Y, CD
        END IF
 
        CM = GetPoint(X, Y)
        'Set center point to the average of all the pixels surrounding it.
        IF CM = 0 THEN
            CM = (C1 + C2 + C3 + C4 + CA + CB + CC + CD) \ 8
            SetPoint X, Y, CM
        END IF
 
        IF X2 - X1 > 2 THEN
            'Recursively subdivide the area into 4 smaller areas.
 
            'CALL SubDivide(X, Y, X2, Y2, CM, CB, C3, CC)
            AStack(sp).X1 = X: AStack(sp).Y1 = Y
            AStack(sp).X2 = X2: AStack(sp).Y2 = Y2
            AStack(sp).C1 = CM: AStack(sp).C2 = CB
            AStack(sp).C3 = C3: AStack(sp).C4 = CC
            sp = sp + 1
 
            'CALL SubDivide(X1, Y1, X, Y, C1, CA, CM, CD)
            AStack(sp).X1 = X1: AStack(sp).Y1 = Y1
            AStack(sp).X2 = X: AStack(sp).Y2 = Y
            AStack(sp).C1 = C1: AStack(sp).C2 = CA
            AStack(sp).C3 = CM: AStack(sp).C4 = CD
            sp = sp + 1
 
            'CALL SubDivide(X, Y1, X2, Y, CA, C2, CB, CM)
            AStack(sp).X1 = X: AStack(sp).Y1 = Y1
            AStack(sp).X2 = X2: AStack(sp).Y2 = Y
            AStack(sp).C1 = CA: AStack(sp).C2 = C2
            AStack(sp).C3 = CB: AStack(sp).C4 = CM
            sp = sp + 1
 
            'CALL SubDivide(X1, Y, X, Y2, CD, CM, CC, C4)
            Y1 = Y
            X2 = X
            C1 = CD
            C2 = CM
            C3 = CC
            GOTO Jag
 
        END IF
 
    LOOP
 
END SUB


'---------------8<-----[ Begin PLASMA.ASM ]----->8---------------

.286: : :
IDEAL
MODEL MEDIUM
;----------------------------------------------------------------
DATASEG
LABEL           LookUp  WORD
                Y = 0
                REPT 200
                dw Y
                Y = Y + 320
                ENDM
RandSeed        dw      0,0
;----------------------------------------------------------------
CODESEG
ASSUME          DS:@CODE, DS:@DATA, SS:@DATA, ES:NOTHING
;----------------------------------------------------------------
;Sets a point in the 320x200x256 mode.
EVEN
PUBLIC SetPoint
PROC SetPoint
Xp              EQU     <[bx+8]>
Yp              EQU     <[bx+6]>
C               EQU     <[bx+4]>
P = 3
                Mov     ax, 0A000h
                Mov es, ax
                Mov bx, sp
                Mov ax, C
                Mov di, Xp
                Mov bx, Yp
                Shl bx, 1
                Add di, (bx + LookUp)
                Stosb
                Retf P * 2
ENDP SetPoint
;----------------------------------------------------------------
;Grabs a point's color in the 320x200x256 mode.
EVEN
PUBLIC GetPoint
PROC GetPoint
Xp              EQU     <[bx+6]>
Yp              EQU     <[bx+4]>
P = 2
                Mov     ax, 0A000h
                Mov es, ax
                Mov bx, sp
                Mov si, Xp
                Mov bx, Yp
                Shl bx, 1
                Add si, (bx + LookUp)
                Xor     ax, ax
                Lods    [byte es:si]
                Retf P * 2
ENDP GetPoint
;----------------------------------------------------------------
;Seeds the psuedo-random number generator.
PUBLIC SeedRand
PROC SeedRand
NewSeedH        EQU     <[bx+6]>
NewSeedL        EQU     <[bx+4]>
P = 2
                Mov bx, sp
                Mov ax, NewSeedL
                Mov (RandSeed), ax
                Mov ax, NewSeedH
                Mov (RandSeed + 2), ax
                Retf P * 2
ENDP SeedRand
;----------------------------------------------------------------
;Returns psuedo-random number between 0 and MaxVal-1.
EVEN
PUBLIC GetRand
PROC GetRand
MaxVal          EQU     <[word bx+4]>
P = 1
                Mov ax, (RandSeed)
                Mov bx, (RandSeed + 2)
                Mov cx, ax
                Mov     dx, 08405h
                Mul dx
                Shl cx, 3
                Add ch, cl
                Add dx, cx
                Add dx, bx
                Shl bx, 1
                Shl bx, 1
                Add dx, bx
                Add dh, bl
                Shl bx, 5
                Add dh, bl
                Add ax, 1
                Adc dx, 0
                Mov (RandSeed), ax
                Mov (RandSeed + 2), dx
                Mov bx, sp
                Mov cx, dx
                Mul MaxVal
                Mov ax, cx
                Mov cx, dx
                Mul MaxVal
                Add ax, cx
                Adc dx, 0
                Mov ax, dx
                Retf P * 2
ENDP GetRand
;----------------------------------------------------------------
END

'---------------8<-----[ End PLASMA.ASM ]----->8---------------
 
'That's all! Although I haven't timed my plasma implementation against
'the one posted here a few days ago, it's visually faster on my 286/10.