home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l076 / 1.ddi / LISSABOX.TRU < prev    next >
Encoding:
Text File  |  1988-08-29  |  2.3 KB  |  91 lines
  1. ! Lissa Box.
  2. !
  3. ! IBM PC version 2.0 copyright (c) 1988 by True BASIC, Inc.
  4. !
  5. set mode "ega"
  6. RANDOMIZE
  7. ASK MAX COLOR colormax
  8. LET colormax = Min(colormax,31)
  9.  
  10. DIM r(15),g(15),b(15)
  11. CALL Init(r,g,b,colormax)
  12.  
  13. SET WINDOW -1.3,1.55,-1.3,1.55
  14. CALL BackCycle(r,g,b,bc,back)
  15. if colormax = 1 then
  16.    let boxcolor = 0
  17. else IF colormax<15 then
  18.    SET BACK 17
  19.    LET boxcolor = 2               !MEDRES, use red box
  20. ELSE
  21.    LET boxcolor = 1               !color -- use various colors for boxes
  22. END IF
  23.  
  24. DO
  25.    IF mod(clock,300)=0 then CALL Reset
  26.    LET x = sin(nx * i)
  27.    LET y = cos(ny * i)
  28.    LET i = i+.01
  29.    LET clock = clock+1
  30.    IF colormax>3 then
  31.       LET boxcolor = boxcolor+1
  32.       IF boxcolor=colormax then LET boxcolor=1
  33.       IF cycleflag<>0 then CALL Cycle(r,g,b,xxx,colormax)
  34.    END IF
  35.    SET COLOR boxcolor
  36.    BOX AREA x,x+.22,y,y+.22
  37.    SET COLOR colormax
  38.    BOX LINES x,x+.22,y,y+.22
  39.    CALL BackCycle(r,g,b,bc,back)
  40. LOOP
  41.  
  42. SUB Reset                         !choose another x,y for lissajous
  43.     CLEAR
  44.     LET nx = Round(7*rnd+1)
  45.     LET ny = Round(9*rnd+1)
  46.     IF nx=1 then LET nx = 3
  47.     IF ny=1 then LET ny = 3
  48.     IF nx=ny then LET nx = nx + 1
  49.     IF rnd<.3 then LET cycleflag=0 else LET cycleflag=1
  50. END SUB
  51. END
  52.  
  53. SUB Init(r(),g(),b(),colormax)    !set 15 colors to rainbow
  54.  
  55.     MAT READ r, g, b
  56.     DATA  1,  1, 1, .6, .3,  0,  0,  0,  0,  0, .3, .6,  1,  1,  1
  57.     DATA .3, .6, 1,  1,  1,  1,  1,  1, .6, .3,  0,  0,  0,  0,  0
  58.     DATA  0,  0, 0,  0,  0, .3, .6,  1,  1,  1,  1,  1,  1, .6, .3
  59.  
  60.     LET j = 1
  61.     FOR i = 1 to colormax
  62.         SET COLOR MIX(i) r(j), g(j), b(j)
  63.         LET j = j + 1
  64.     NEXT i
  65.  
  66. END SUB
  67.  
  68. SUB Cycle(r(),g(),b(),c,colormax)      !cycle colors
  69.     LET c1 = mod(c,14)+1
  70.     LET j = c
  71.     FOR i = colormax-1 to 1 step -1
  72.         LET j = j-1
  73.         IF j<1 then LET j=colormax-1
  74.         SET COLOR MIX (i) r(j),g(j),b(j)
  75.     NEXT i
  76.     LET c = c1
  77. END SUB
  78.  
  79. SUB BackCycle(r(),g(),b(),bc,back)     !cycle background colors
  80.     LET bc = bc-.125              !bc is intensity
  81.     IF bc<0 then
  82.        LET back = mod(back,14)+1
  83.        LET bc = 1
  84.     END IF
  85.     LET back1 = mod(back,30)+1
  86.     LET r1 = (bc*r(back)+(1-bc)*r(back1)) * .9
  87.     LET g1 = (bc*g(back)+(1-bc)*g(back1)) * .6
  88.     LET b1 = (bc*b(back)+(1-bc)*b(back1)) * .7
  89.     SET COLOR MIX(0) r1, g1, b1
  90. END SUB
  91.