'===========================================================================
' Subject: 132-COLUMNS TEXT PLASMA           Date: 09-29-98 (13:22)       
' Author:  Anders Olofsson                   Code: QB, QBasic, PDS        
' Origin:  anders.olofsson@mail.bip.net    Packet: TEXT.ABC
'===========================================================================
' Slightly modified "plasma.bas" - 132-column Text Plasma
'
'                                  by Anders Olofsson 1998.
'
'                 e-mail: anders.olofsson@mail.bip.net
'
'  Compile for maximum speed!
'

DEFINT A-Z
DECLARE SUB TxtPalSet (C%, R%, G%, B%)
DECLARE SUB ResetScreen ()
DECLARE SUB Center (Row%, Text$, ForeColour%, BackColour%)
DECLARE SUB pPrint (Row%, col%, S$, ForeColour%, BackColour%)
DECLARE SUB Set132 (Rows%)
DECLARE SUB ClearScreen ()
DECLARE SUB PutScr (Row%, col%, Buffer%(), Scrnum%)
DECLARE SUB GetScr (Row1%, Col1%, Wid%, Hei%, Buffer%(), Scrnum%)

' Change these to suit your needs.
 COMMON SHARED ScreenWid, ScreenHei, ScreenSeg
 ScreenWid = 132: ScreenHei = 43: ScreenSeg = &HB800

 DIM Sine(525) AS INTEGER, Cosine(405) AS INTEGER

  Set132 43
  LOCATE , , 0

NewPattern:
 RANDOMIZE TIMER * TIMER
 
  ClearScreen

  DEF SEG = &HB800
  FOR I = 0 TO ScreenHei * ScreenWid * 2 STEP 2
GetChr: C = RND * 254 + 1
   IF C = 32 OR C = 255 THEN GOTO GetChr ELSE POKE I, C
   POKE I + 1, 0
  NEXT
 
 R1 = RND * 5 + 1: R2 = RND * 5 + 1: R3 = RND * 5 + 1
 FOR C = 0 TO 15
  I = C: TxtPalSet I, C * R1, C * R2, C * R3
  IF RND AND 1 AND C = 6 THEN
   I = C: TxtPalSet I, C * R3, C * R2, C * R1
  END IF
 NEXT

 Rad1! = (4 * ATN(1)) / (50 + RND * 50): Rad2! = (4 * ATN(1)) / (50 + RND * 50)

 FOR x = 0 TO 520: Sine(x) = SIN(Rad1! * x) * 15: NEXT
 FOR x = 0 TO 400: Cosine(x) = COS(Rad2! * x) * 15: NEXT
 Current1 = RND * 200: Current2 = RND * 200

  C1 = RND * 4 + 1: C2 = RND * 4 + 1

DO
Current1 = Current1 + C1: Current2 = Current2 + C2
IF Current1 >= 200 THEN C1 = -C1
IF Current1 <= 0 THEN C1 = RND * 4 + 1: Current1 = 0
IF Current2 >= 200 THEN C2 = -C2
IF Current2 <= 0 THEN C2 = RND * 4 + 1: Current2 = 0

 Memory = 1
 FOR y = 0 TO 42
   x = 0
  FOR tx = 0 TO 131
    x = x + 2
    C = ABS((Sine(x + Current1) + Cosine(y + Current2 \ 2) + Cosine(x \ 2) + Sine(y * 2)) \ 2) \ 2
    IF C <= 0 THEN C = 1
    POKE Memory, C: Memory = Memory + 2
  NEXT
 NEXT

 WAIT &H3DA, 8: WAIT &H3DA, 8, 1

 K$ = INKEY$
 IF K$ = CHR$(13) OR K$ = " " GOTO NewPattern

LOOP UNTIL LEN(K$)

ResetScreen

SUB Center (Row, Text$, ForeColour, BackColour)
pPrint Row, (ScreenWid \ 2) - (LEN(Text$) \ 2), Text$, ForeColour, BackColour
END SUB

SUB ClearScreen
DEF SEG = ScreenSeg
FOR I = 0 TO ScreenHei * ScreenWid * 2
 POKE I, 0
NEXT
END SUB

SUB GetScr (Row1, Col1, Wid, Hei, Buffer%(), Scrnum)
DEF SEG = ScreenSeg
Buffer%(Scrnum, 0) = 256 * Wid + Hei
FOR R = Row1 TO Row1 + Hei - 1
FOR C = Col1 TO Col1 + Wid - 1
  Chrcode = PEEK(((R - 1) * ScreenWid + C - 1) * 2)
  ColrCode = PEEK(((R - 1) * ScreenWid + C - 1) * 2 + 1)
  Counter = Counter + 1
  Buffer%(Scrnum, Counter) = -32768 + 256& * ColrCode + Chrcode
NEXT
NEXT
END SUB

SUB pPrint (Row, col, S$, ForeColour, BackColour)
IF Row > ScreenHei OR Row < 1 OR col > ScreenWid OR col < 1 THEN EXIT SUB
DEF SEG = ScreenSeg: Memloc = ScreenWid * (Row - 1) + (col - 1): Memloc = Memloc + Memloc
FOR T = 0 TO LEN(S$) - 1
 IF col + T > ScreenWid THEN EXIT FOR
 POKE Memloc, ASC(MID$(S$, T + 1, 1))
 POKE Memloc + 1, BackColour * 16 + ForeColour
 Memloc = Memloc + 2
NEXT T
DEF SEG
END SUB

SUB PutScr (Row, col, Buffer%(), Scrnum)
Wid = Buffer%(Scrnum, 0) \ 256: Hei = Buffer%(Scrnum, 0) MOD 128
DEF SEG = ScreenSeg
FOR R = Row TO Row + Hei - 1
FOR C = col TO col + Wid - 1
  Counter = Counter + 1
  IF C <= ScreenWid AND C >= 1 THEN
   Chrcode = Buffer(Scrnum, Counter) MOD 256
   ColrCode = (Buffer(Scrnum, Counter) + 32768) \ 256
   POKE (((R - 1) * ScreenWid + C - 1) * 2), Chrcode
   POKE (((R - 1) * ScreenWid + C - 1) * 2) + 1, ColrCode
  END IF
NEXT
NEXT
END SUB

SUB ResetScreen
asm$ = CHR$(&HB8) + CHR$(3) + CHR$(0)
asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) + CHR$(&HCB)
DEF SEG = VARSEG(asm$): CALL absolute(SADD(asm$))
END SUB

SUB Set132 (Rows)
IF Rows = 43 THEN Vidmode = &H54
IF Rows = 25 THEN Vidmode = &H55
IF Vidmode = 0 THEN EXIT SUB
asm$ = asm$ + CHR$(&HB8) + CHR$(Vidmode) + CHR$(0)
asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) + CHR$(&HCB)
DEF SEG = VARSEG(asm$): CALL absolute(SADD(asm$))
END SUB

SUB TxtPalSet (C, R, G, B)
IF C >= 8 AND C <= 15 THEN C = C + 48 ELSE IF C = 6 THEN C = 20
OUT &H3C8, C: OUT &H3C9, R: OUT &H3C9, G: OUT &H3C9, B
END SUB