'=========================================================================== ' Subject: SVGA PLASMA, 800X600X256 Date: 07-06-98 (22:27) ' Author: Anders Olofsson Code: QB, QBasic, PDS ' Origin: anders.olofsson@mail.bip.net Packet: GRAPHICS.ABC '=========================================================================== ' ' SVGA Plasma, 800x600x256 version. ' ' By Anders Olofsson 1998. ' ' E-mail: anders.olofsson@mail.bip.net ' '------------------------------------------------------- ' ** Compile for maximum speed ** ' ' Press space to change palette rotation direction ' Press "P" to get a new palette ' Press "N" to get new plasma ' Press Enter to save current plasma in a bitmap file!!! '------------------------------------------------------- ' ' Thanks to: ' Andrew S. Gibson - Switchbank & dpoint & dpset ' (Switchbank has been converted to asm-code, so that ' Qbasic users can run this program.) ' '------------------------------------------------------- DEFINT A-Z DECLARE SUB Switchbank (NB%) DECLARE FUNCTION DPOINT% (XCOORD%, YCOORD%) DECLARE SUB dpset (XCOORD%, YCOORD%, CL%) DECLARE SUB CyclePalette (Dir%) DECLARE SUB Paletteget (A%, R%, G%, B%) DECLARE SUB PutBox (x%, y%, c%, s%) DECLARE SUB putpix (x%, y%, c%) DECLARE SUB MakeRandomPalette () DECLARE SUB Pal (A%, R%, G%, B%) DECLARE SUB SetScreenmode (SM%) CONST Noise = 0 ' If you want noise, change the value to 1 CONST StartSize = 7 ' Bigger value = bigger clouds... CONST Plasmatimer = 120 ' Changes plasma every .. second(s). CONST PaletteTimer = 30 ' Changes palette every .. second(s). File$ = "PLASMA" ' Name of the captured files... (this will turn out ' plasma.bmp, plasma1.bmp, plasma2.bmp and so on...) '------------------------------------------------------- TYPE RegtypeX AX AS INTEGER BX AS INTEGER cx AS INTEGER DX AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER ds AS INTEGER es AS INTEGER END TYPE DIM SHARED Bank%, Table&(0 TO 805) FOR Height% = 0 TO 805: Table&(Height%) = Height% * 800&: NEXT Height% SCREEN 13 SetScreenmode &H103 GOSUB ChangePalette CurrentDir = 1 RedrawPlasma: FOR y = 0 TO 599 STEP StartSize FOR x = 0 TO 799 STEP StartSize c = RND * 254 + 1 FOR tx = x TO x + StartSize FOR ty = y TO y + StartSize dpset tx, ty, c NEXT NEXT NEXT IF LEN(INKEY$) THEN EXIT FOR NEXT DEF SEG = &HA000 FOR s = StartSize - 1 TO 1 STEP -1 FOR y = 0 TO 599 STEP s FOR x = 0 TO 799 STEP s c = (DPOINT(x, y) + DPOINT(x + s, y + s) + DPOINT(x + s, y) + DPOINT(x, y + s)) \ 4 FOR tx = x TO x + s FOR ty = y TO y + s dpset tx, ty, c NEXT NEXT NEXT IF LEN(INKEY$) THEN EXIT FOR: EXIT FOR NEXT NEXT IF Noise THEN FOR y = 0 TO 199 FOR x = 0 TO 319 c = DPOINT(x, y) dpset x, y, c NEXT CyclePalette CurrentDir NEXT END IF PlasmaCounter! = TIMER PaletteCounter! = TIMER DO Keys$ = UCASE$(INKEY$) IF LEN(Keys$) THEN IF Keys$ = " " AND CurrentDir = 2 THEN CurrentDir = 1: Keys$ = "" IF Keys$ = " " AND CurrentDir = 1 THEN CurrentDir = 2 IF Keys$ = "P" THEN GOSUB ChangePalette: Keys$ = "" IF Keys$ = "N" THEN GOTO RedrawPlasma END IF CyclePalette CurrentDir IF TIMER - PlasmaCounter! > Plasmatimer THEN GOTO RedrawPlasma IF TIMER - PaletteCounter! > PaletteTimer THEN GOSUB ChangePalette 'Lots of retraices... else it goes to fast! WAIT &H3DA, 8: WAIT &H3DA, 8, 1 WAIT &H3DA, 8: WAIT &H3DA, 8, 1 LOOP UNTIL LEN(Keys$) AND Keys$ <> " " FOR x = 0 TO 63 'Fade out FOR c = 0 TO 255 Paletteget c, R, G, B IF R THEN R = R - 1 IF G THEN G = G - 1 IF B THEN B = B - 1 Pal c, R, G, B NEXT WAIT &H3DA, 8: WAIT &H3DA, 8, 1 NEXT SCREEN 13: SCREEN 0: WIDTH 80, 25 END ChangePalette: PaletteCounter! = TIMER R = INP(64) \ 5: G = INP(64) \ 5: G = INP(64) \ 5 Pal 1, R, G, B: Pal 255, R + (10 * RND), G + (10 * RND), B + (10 * RND) MakeRandomPalette Pal 0, 0, 0, 0 Pal 64, 63, 63, 0 RETURN SUB CyclePalette (Dir) IF Dir = 1 THEN FOR t = 2 TO 255 Paletteget t, R, G, B Pal t - 1, R, G, B NEXT Paletteget 1, R, G, B Pal 255, R, G, B ELSE Paletteget 255, R, G, B Pal 1, R, G, B FOR t = 254 TO 1 STEP -1 Paletteget t, R, G, B Pal t + 1, R, G, B NEXT END IF WAIT &H3DA, 8 WAIT &H3DA, 8, 1 END SUB FUNCTION DPOINT% (XCOORD, YCOORD) NewBank% = (Table&(YCOORD) + XCOORD) \ 65536 IF NewBank% <> Bank% THEN Switchbank NewBank% DEF SEG = &HA000 DPOINT% = PEEK((Table&(YCOORD) + XCOORD) MOD 65536) DEF SEG END FUNCTION SUB dpset (XCOORD, YCOORD, CL%) NewBank% = (Table&(YCOORD) + XCOORD) \ 65536 IF NewBank% <> Bank% THEN Switchbank NewBank% DEF SEG = &HA000 POKE (Table&(YCOORD) + XCOORD) MOD 65536, CL% DEF SEG END SUB SUB MakeRandomPalette DIM used(0 TO 255) AS STRING * 2: used(0) = CHR$(1) + CHR$(255): s = 1 DO getnext: IF s = 0 THEN EXIT DO s = s - 1 c1 = ASC(used(s)): c2 = ASC(RIGHT$(used(s), 1)) current = (c1 + c2) \ 2 IF c1 = c2 OR current = c1 OR current = c2 GOTO getnext Paletteget c1, r1, g1, b1: Paletteget c2, r2, g2, b2 t = (ABS(c1 - c2) \ 8) * ((INP(64) MOD 3) - 1) R = (r1 + r2) \ 2 + t: G = (g1 + g2) \ 2 + t: B = (b1 + b2) \ 2 + t Pal current, R, G, B used(s) = CHR$(c1) + CHR$(current): s = s + 1 used(s) = CHR$(current) + CHR$(c2): s = s + 1 LOOP UNTIL s = 0 Pal 0, 0, 0, 0 END SUB SUB Pal (A, R, G, B) OUT &H3C8, A OUT &H3C9, R OUT &H3C9, G OUT &H3C9, B END SUB SUB Paletteget (A, R, G, B) OUT &H3C7, A R = INP(&H3C9) G = INP(&H3C9) B = INP(&H3C9) END SUB SUB SetScreenmode (SM) 'SM (ScreenMode) may be any one of the following: '3 = Text Mode '&H100 = 640x400x256 '&H101 = 640x480x256 '&H102 = 800x600x16 '&H103 = 800x600x256 '&H104 = 1024x768x16 '&H105 = 1024x768x256 ' 'Interrupt converted to assembly code by Anders Olofsson. asm$ = CHR$(&HB8) + MKI$(&H4F02) asm$ = asm$ + CHR$(&HBB) + MKI$(SM) asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) asm$ = asm$ + CHR$(&HCB) DEF SEG = VARSEG(asm$) CALL Absolute(SADD(asm$)) DEF SEG END SUB SUB Switchbank (NB%) 'DIM Registers AS RegtypeX ' Registers.AX = &H4F05 ' Registers.BX = 0 ' Registers.DX = NB% ' CALL InterruptX(&H10, Registers, Registers) ' Bank% = NB% 'Converted to Qbasic code... asm$ = CHR$(&HB8) + CHR$(5) + CHR$(&H4F)'MKI$(&H4F05) asm$ = asm$ + CHR$(&HBB) + MKI$(0) asm$ = asm$ + CHR$(&HBA) + CHR$(NB%) + CHR$(0) asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) asm$ = asm$ + CHR$(&HCB) DEF SEG = VARSEG(asm$): o = SADD(asm$): CALL Absolute(o): DEF SEG Bank% = NB% END SUB