'===========================================================================
' Subject: BURNING CANDLE SIMULATION          Date: 10-13-00 (17:44)       
'  Author: Dieter Folger                      Code: PB                     
'  Origin: folger@bnv-bamberg.de            Packet: PB.ABC
'===========================================================================
'==================================
' CANDLE.BAS for PowerBasic 3.2
' Burning candle simulation
'==================================
DEFINT A - Z
DIM c(11) AS INTEGER
RANDOMIZE TIMER
Screen13

'Set palette colors
FOR i = 1 TO 140
    IF i < 32 THEN Palette13 i, i, 0, 0
    IF i => 32 AND i < 63 THEN
       INCR g : Palette13 i, i, g ,0
    ELSEIF i => 63 AND i < 95 THEN
       INCR g : Palette13 i, 63, g ,0
    ELSEIF i => 95 AND i <= 140 THEN
       INCR b : Palette13 i, 63, 63, b
    END IF
NEXT i
'Draw some stars on blue background
Palette13 0, 0, 0, 15
FOR i = 150 TO 220
    INCR s : Palette13 i, s, s, s
NEXT
FOR i = 1 TO 300
    x = RND * 320
    y = RND * 200
    c = (RND * 62) + 120
    Pset13 x, y, c
NEXT

'Paint candle stump
cc = 10
FOR i = 140 TO 170
    IF cc < 30 THEN INCR cc
    Line13 i, 105, i, 200, cc
NEXT i

'Paint flame
DO 'main loop starts here
  y = 100
  DO
   DECR y
   FOR x = 150 TO 161
       c = Point13(x, y + 1)
       IF c = 0 THEN INCR x: c = Point13(x, y + 1)
       DECR c, 3
       IF c > 140 OR c < 0 THEN c = 0
       Pset13 x, y, c
   NEXT x
  LOOP UNTIL Point13(156, y) = 0
  Line13 156, y - 1,156, y - 1, 0

  'Make it flicker
  i = RND * 10
  IF i MOD 2 = 0 THEN c(6) = c(6) + 1 ELSE c(6) = c(6) - 1
  IF c(6) <= 100 - 1 THEN c(6) = 100 + 1
  IF c(6) >= 140 + 1 THEN c(6) = 140 - 1
  c(1) = c(6) - 100 : c(2) = c(6) - 80
  c(3) = c(6) - 60  : c(4) = c(6) - 40
  c(5) = c(6) - 20  : c(7) = c(5)
  c(8) = c(4)       : c(9) = c(3)
  c(10) = c(2)      : c(11) = c(1)
  FOR i = 1 TO 11
      IF c(i) < 0 THEN c(i) = 0
      Pset13 150 + i, 100, c(i)
      Pset13 150 + i, 101, c(i) - 10
      IF Point13(150 + i, 101) > 140 THEN Pset13 150 + i, 101, 0
      Pset13 150 + i, 102, c(i) - 30
      IF Point13(150 + i, 102) > 140 THEN Pset13 150 + i, 102, 0
      Pset13 150 + i, 103, c(i) - 75
      IF Point13(150 + i, 103) > 140 THEN Pset13 150 + i, 103, 0
  NEXT
  'Candle wick
  Pset13 155, 103, 141 : Pset13 156, 102, 141
LOOP UNTIL INSTAT

TextScreen
END

'-----------
SUB Screen13
'-----------
  ! mov ax, &h13
  ! int &h10
END SUB
'----------
SUB TextScreen
'----------
  ! mov ax, &h3
  ! int &h10
END SUB
'-----------------------------------------
SUB Pset13 (BYVAL x ,BYVAL y ,BYVAL col)
'-----------------------------------------
  ! mov ax, &hA000
  ! mov es, AX
  ! mov ax, 320
  ! mul y
  ! mov bx, x
  ! add bx, AX
  ! mov al, col
  ! mov es:[bx] , AL
END SUB
'-------------------------------------------------------------------
FUNCTION Point13(BYVAL x, BYVAL y) as INTEGER
'-------------------------------------------------------------------
  ! Mov  di, y
  ! dw   &hE7C1
  ! db   8
  ! mov  bx, y
  ! dw   &hE3C1
  ! db   6
  ! add  di, x
  ! mov  ax,&hA000
  ! mov  es, ax
  ! add  di, bx
  ! mov  dl, es:[di]
  ! mov  FUNCTION, dl
END FUNCTION
'-------------------------------------------------------------------------
SUB Line13 (x1, y1, x2, y2, col)
'-------------------------------------------------------------------------
 IF x1 < x2 THEN xdir = 1 ELSE xdir = -1
 IF y1 < y2 THEN ydir = 1 ELSE ydir = -1
 dx = ABS(x1 - x2) : dy = ABS(y1 - y2)
 IF dx => dy THEN
    dy = 2 * dy : om = dy - dx : dx = 2 * dx
    FOR p = 0 TO dx \ 2
        Pset13 x1, y1, Col
        IF om > 0 THEN INCR y1, ydir : DECR om, dx
        INCR om, dy :INCR x1, xdir
    NEXT
 ELSE
    dx = 2 * dx : om = dx - dy : dy = 2 * dy
    FOR p = 0 TO dy \ 2
        Pset13 x1, y1, Col
        IF om > 0 THEN INCR x1, xdir : DECR om, dy
        INCR om, dx : INCR y1, ydir
    NEXT
 END IF
END SUB
'------------------------------------------------------
SUB Palette13 (BYVAL col,BYVAL r, BYVAL g, BYVAL b)
'------------------------------------------------------
 OUT &h3C8, col
 OUT &h3C9, r
 OUT &h3C9, g
 OUT &h3C9, b
END SUB
'= eof =======================================================================