rexx/progs/kaleid.r

   1 /*===================================================================*/
   2 /*     Bill N. Vlachoudis                                     o o    */
   3 /*     Computer adDREss.......V.Vlachoudis@cern.ch          ____oo_  */
   4 /*     HomE AdDreSs...........Parodos Filippoy 51          /||    |\ */
   5 /*   !                        TK 555-35 Pylaia              ||    |  */
   6 /* !  tHe bESt Is             ThesSALONIKI, GREECE          '.___.'  */
   7 /*  Y e t  to   Co mE !                                     MARMITA  */
   8 /*===================================================================*/
   9 call load 'ansi.r'
  10 signal on halt
  11 colors = 'BLUE GREEN MAGENTA RED CYAN YELLOW WHITE BLACK'
  12 colors = 'BLACK MAGENTA BLUE RED GREEN CYAN YELLOW WHITE'
  13 do i=1 to words(colors)
  14         col.i = word(colors,i)
  15 end
  16
  17 hd.1  = "   ******  ****              ****                         ****"
  18 hd.2  = "    ***     **                 **              **          ***"
  19 hd.3  = "     **    **                  **              **           **"
  20 hd.4  = "    **    **                  **                           **"
  21 hd.5  = "    **  **         **** **    **      ****   ***      **** **"
  22 hd.6  = "    *****         **  ***    **      **  **   **     ** ****"
  23 hd.7  = "   *****         **    **    **     **   **   **    **    **"
  24 hd.8  = "   **  **        **    **    **    **   **   **    **     **"
  25 hd.9  = "   **  **       **    **    **    *******    **    **     **"
  26 hd.10 = "  **    **      **    **    **    **         **   **     **"
  27 hd.11 = "  **     **     **   ***   **     **        **    **     **"
  28 hd.12 = " ***     ***    **  **** * ** *   **   **   ** *  **   **** *"
  29 hd.13 = "*****   ******   **** ***  ****    *****    ****   ***** ****"
  30 hd.0 = 13
  31
  32 n = copies(' ',68);
  33 call AnsiCls
  34 say n "   o o   "
  35 say n " ____oo_ "
  36 say n "/||    |\"
  37 say n " ||    | "
  38 say n " `.___.' "
  39 say n " MARMITA "
  40 drop n
  41 do i=1 to hd.0
  42         say '      ' hd.i
  43 end
  44 text.1 = center('by bill vlachoudis V.Vlachoudis@cern.ch (c)1988',79)
  45 text.2 = center('for DOS ANSI.SYS is required.',79)
  46 text.3 = center('Press <ENTER> to continue,  Control-C to stop',79)
  47 do i=1 to 3
  48         say text.i
  49 end
  50
  51 /* scroll a little bit the colors */
  52 do i=1 to 80
  53         do j=1 to hd.0
  54                 p = i-j
  55                 if p>0 then do
  56                         c = substr(hd.j,p,1)
  57                         if c=='*' then do
  58                                 call AnsiColor "BOLDYELLOW"
  59                                 call AnsiGoto p+7,j+6
  60                                 call write ,'*'
  61                         end
  62                 end
  63                 p = i-j-4
  64                 if p>0 then do
  65                         c = substr(hd.j,p,1)
  66                         if c=='*' then do
  67                                 call AnsiColor "RED"
  68                                 call AnsiGoto p+7,j+6
  69                                 call write ,'*'
  70                         end
  71                 end
  72         end j
  73         /* delay a while */
  74         call time 'r'
  75         do while time('e')<0.012
  76                 nop
  77         end
  78         call flush "<STDOUT>"
  79 end i
  80
  81 /* put random colors to text */
  82 do i=1 to 3
  83         do j=1 to length(text.i)
  84                 ch = substr(text.i,j,1)
  85                 if ch ^== " " then do
  86                         c = random(0,15)
  87                         if c>7 then col="BOLD"; else col=""
  88                         c = c//7+1
  89                         call Ansicolor col||col.c
  90                         call AnsiGoto j,i+19
  91                         call write ,ch
  92                         call flush "<STDOUT>"
  93                 end
  94         end j
  95 end i
  96
  97 pull .
  98 call AnsiCls
  99 Do w = 3 to 50
 100         Do i = 1 to 39
 101                 Do j = 1 to 39
 102                         k = i + j
 103                         c = trunc(j * 3 / (i + 7) + i * w / 24)
 104                         if c > 15 then c = c - 15
 105                         xl = i
 106                         xr = 80 - xl
 107                         yt = trunc(k/4 + 0.5)
 108                         yb = 21 - yt
 109                         if c > 7 then col = 'BOLD'; else col = ''
 110                         cc = c//7+1
 111                         col = col col.cc
 112                         Call AnsiColor col,col.cc
 113
 114                         call AnsiGoto xl,yt; call write ,'#'
 115                         call AnsiGoto xr,yt; call write ,'#'
 116                         call AnsiGoto xl,yb; call write ,'#'
 117                         call AnsiGoto xr,yb; call write ,'#'
 118                         yt = trunc(i/4 + 0.5)
 119                         yb = 21 - yt
 120                         xl = trunc(k)
 121                         xr = 80 - xl
 122                         call AnsiGoto xl,yt; call write ,'#'
 123                         call AnsiGoto xr,yt; call write ,'#'
 124                         call AnsiGoto xl,yb; call write ,'#'
 125                         call AnsiGoto xr,yb; call write ,'#'
 126                         call flush "<STDOUT>"
 127                 End
 128         End
 129 End
 130
 131 exit:
 132 halt:
 133 call AnsiCls
 134 call AnsiAttr "normal"
 135 exit 0