home *** CD-ROM | disk | FTP | other *** search
/ The Equalizer BBS / equalizer-bbs-collection_2004.zip / equalizer-bbs-collection / DEMOSCENE-STUFF / K-BBS.ZIP / CALL-IT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-31  |  10KB  |  361 lines
  1. Program Call_It;{
  2. ══════════════════════════════════════════════════════════════════════════════
  3.                                                Gautier Portet  impulse/KNIGHTS
  4.   "BBS Advert for LiTHiUM"                          3, Place Ferdinand Buisson
  5. Copyright KNIGHTS  1996                             31240 St Jean       France
  6.  
  7. All Code by impulse . KNIGHTS             FAX: (+33) 35 69 44 83 (EcLiPsE)
  8. ══════════════════════════════════════════════════════════════════════════════
  9.              │
  10.             -.▄█  ██▄ ▄█   █▄  ▄█  ▄████▄  ▄█   █▄ ▀████▄ ▄█████▄
  11.              │██ ██   ███  ██  ██  ██      ██   ██   ██   ██
  12.               ███▌    ██ █ ██  ██  ██ ▄██▄ ███████   ██    █████▄
  13.               ██ ██   ██  ███  ██  ██    █ ██   ██   ██        ██
  14.               ▀█  ██▄ ▀█   █▀  █▀  ▀█████▀ ▀█   █▀   █▀   ▄█████▀
  15.                                                        εcLiPsε ]<
  16. coded by impluse 08..09/07/96
  17. [ KNIGHTS Official Source Code ]
  18.  
  19. - Couleurs de t...... , Copyright Remdy / CeQuiVaAvecLaBrosseàDent 1996  :)
  20. - 60% pur Pascal (lame!) code , Copyright impulse/KNIGHTS 1996
  21.  
  22. You can do whatever you want with this source code.
  23. It is PUBLIC DOMAIN.
  24. But as I'm the creator of it, I want the credits and Greets if you use it (?!)
  25.  
  26. If you want a BBS addy, just ask !
  27. }
  28.  
  29. {$M 1024,0,0}
  30. {$G+}
  31. {$B-}
  32. {$D-}
  33. {$A+}
  34. {$N-}
  35.  
  36.  
  37. const
  38. Sinus : Array[0..255] of byte = (
  39.  63,
  40.  69,  75,  81,  87,  93,  98, 103, 108, 112, 116, 119, 121, 123, 125, 126, 126,
  41. 126, 125, 123, 121, 118, 115, 111, 107, 102,  97,  92,  86,  81,  75,  68,  62,
  42.  56,  50,  44,  38,  33,  27,  22,  18,  14,  10,   7,   4,   2,   1,   0,   0,
  43.   0,   1,   3,   5,   8,  11,  15,  19,  24,  29,  35,  40,  46,  52,  58,  65,
  44.  71,  77,  83,  89,  94,  99, 104, 109, 113, 116, 119, 122, 124, 125, 126, 126,
  45. 125, 124, 123, 120, 118, 114, 110, 106, 101,  96,  91,  85,  79,  73,  67,  61,
  46.  54,  48,  42,  37,  31,  26,  21,  17,  13,   9,   6,   4,   2,   1,   0,   0,
  47.   1,   2,   4,   6,   9,  12,  16,  21,  25,  30,  36,  42,  48,  54,  60,  66,
  48.  72,  78,  84,  90,  96, 101, 105, 110, 114, 117, 120, 122, 124, 125, 126, 126,
  49. 125, 124, 122, 120, 117, 113, 109, 105, 100,  95,  89,  84,  78,  72,  65,  59,
  50.  53,  47,  41,  35,  30,  25,  20,  16,  12,   8,   6,   3,   2,   1,   0,   0,
  51.   1,   2,   4,   7,  10,  13,  17,  22,  27,  32,  37,  43,  49,  55,  61,  68,
  52.  74,  80,  86,  91,  97, 102, 107, 111, 115, 118, 121, 123, 125, 126, 126, 126,
  53. 125, 124, 122, 119, 116, 112, 108, 104,  99,  93,  88,  82,  76,  70,  64,  58,
  54.  51,  45,  40,  34,  29,  24,  19,  15,  11,   8,   5,   3,   1,   0,   0,   0,
  55.   1,   3,   5,   7,  10,  14,  18,  23,  28,  33,  39,  45,  51,  57,  63 );
  56. { iMPULSE's Sinus Generator version 5.4 }
  57.  
  58. const logo : array[1..14] of string[80] = (
  59. ' █          ████       ████       █     █    ████       █     █    █     █   ',
  60. ' ██         ██████     ██████     ██    ██   ██████     ██    ██   ██    ██  ',
  61. ' ███        ████████   ████████   ███   ███  ████████   ███   ███  ███   ███ ',
  62. ' ████       ██████████ ██████████ ████  ████ ██████████ ████  ████ ████  ████',
  63. ' ████          █          █       ████  ████    █       ████  ████ █████ ████',
  64. ' ████          ██         ██      ████  ████    ██      ████  ████ ██████████',
  65. ' ████   '+chr(24)+'      ███        ███     ████  ████    ███     ████  ████ ████  ████',
  66. ' ████  '+chr(27)+'■'+chr(26)+'     ████       ████    █████ ████    ████    ████  ████ ████  ████',
  67. ' ████   '+chr(25)+'      ████       ████    ██████████    ████    ████  ████ ████  ████',
  68. ' ████          ████       ████    ████  ████    ████    ████  ████ ████  ████',
  69. ' █████████  ██████████    ████    ████  ████ ██████████ ████  ████ ████  ████',
  70. ' █████████  ██████████    ████    ████  ████ ██████████ ████  ████ ████  ████',
  71. ' █████████  ██████████    ████    ████  ████ ██████████ █████ ████ ████  ████',
  72. ' █████████  ██████████    ████    ████  ████ ██████████ ██████████ ████  ████');
  73.  
  74. number : array[1..8] of string[80] = (
  75. '  ██ ██████ ██████ ██ ███    ██████ ███    ██████ ██████ ██████ ██████ ██████',
  76. '  █     ███    ███  █ ███    ███    ███       ███    ███    ███    ███    ███',
  77. '  █     ███    ███  █ ███    ███    ███       ███    ███    ███    ███    ███',
  78. '  █     ███    ███  █ ███    ███    ███       ███    ███    ███    ███    ███',
  79. '  █     ███    ███  █ ███    ███    ███       ███    ███    ███    ███    ███',
  80. '  █    ████ ██████  █~██████ ██████~██████   ████~  ████    ███~  ████ ██████',
  81. '  █     ███ ███     █ ██▌▐██    ███ ██▌▐██    ███    ███    ███    ███ ███   ',
  82. '  ██ ██████ ██████ ██ ██████ ██████ ██████ ██████ ██████    ███ ██████ ██████');
  83.  
  84.  
  85.  
  86. var
  87.  
  88. n , m ,add1,add2,phi    : word;
  89. fin                     : boolean;
  90. index,add_index         : byte;
  91.  
  92.  
  93.  
  94. PROCEDURE Init_Curseur; ASSEMBLER;
  95. { Vire cette saloperie de putain de curseur !!!!!}
  96. ASM
  97.   mov     ah,1
  98.   mov     cx,2020h
  99.   int     10h
  100. end;
  101.  
  102.  
  103. procedure print(x,y : byte ;st : string; c : byte);
  104. { affiche une chaine ... repompé ?!?!        :) }
  105. { j'en ai une en ASM, mais bon ... }
  106. var Offset   : word;
  107.     i, j     : byte;
  108.     Attribut : word;
  109.     colonne  : byte;
  110. begin
  111.   Offset := y * 160 + x shl 1 ;
  112.   Attribut := c shl 8;
  113.   i := length( St );
  114.   for j:=1 to i do
  115.     begin
  116.       memw[$b800:Offset] := Attribut or ord( St[j] );
  117.       Offset := Offset + 2;
  118.     end;
  119. end;
  120.  
  121. procedure SetRGB(color : integer; r,g,b : byte); assembler;
  122. asm
  123.         cli
  124.         mov     dx,$3C8
  125.         mov     ax,color
  126.         out     dx,al
  127.         inc     dx
  128.         mov     al,r
  129.         out     dx,al
  130.         mov     al,g
  131.         out     dx,al
  132.         mov     al,b
  133.         out     dx,al
  134.         sti
  135. end;
  136.  
  137. procedure wait_VBL; assembler;
  138. asm
  139.         mov     dx,3DAh
  140. @t1:
  141.         in      al,dx
  142.         test    al,8
  143.         jz      @t1
  144.         cli
  145. @t2:
  146.         in      al,dx
  147.         test    al,8
  148.         jnz     @t2
  149.         sti
  150. end;
  151.  
  152. procedure do_vagues ;assembler ;
  153. asm
  154.    mov  ax,0b800h
  155.    mov  es,ax
  156.    mov  di,49*160+1
  157.    xor  cx,cx
  158.    mov  bl,index
  159.    mov  dx,32
  160.    mov  si,n
  161.    mov  bx,phi
  162.  
  163. @loop:
  164.          add  si,add1
  165.          add  bx,add2
  166.          and  bx,255
  167.          and  si,255
  168.          mov  cl,byte ptr sinus[si]
  169.          add  cl,byte ptr sinus[bx]
  170.          mov  dx,32
  171.          shr  cl,3
  172.          sub  dl,cl
  173.          mov  ax,1+16*2
  174.          inc  cl
  175. @loop1:
  176.                 mov  es:[di],al
  177.                 add  di,2
  178.                 dec  cx
  179.              jnz  @loop1
  180.  
  181.              mov  ax,1
  182. @loop2:
  183.                 mov  es:[di],al
  184.                 add  di,2
  185.                 dec  dl
  186.              jnz  @loop2
  187.  
  188.          sub  di,160+66
  189.          or   di,di
  190.        jns  @loop
  191.  
  192. end;
  193.  
  194.  
  195.  
  196. procedure intro;
  197. const max = 4;
  198.  
  199. const scroll : string =
  200. (
  201. '                           Call LiTHiUM bbs           KNIGHTS Belgium  HeadQuarter       (32)-65-63-37-32                '
  202. +'                                  ');
  203.  
  204. const texte : array[1..max] of string[80] =
  205. (
  206. '      !! W A R N I N G !!      ',
  207. '   K · N · I · G · H · T · S   ',
  208. '      Belgium HeadQuarter      ',
  209. '          CALL  NOW :          '
  210. );
  211. const pos : array [1..max] of byte =
  212. (34,35,36,37);
  213.  
  214. var sc_i : byte;
  215. st : string[28];
  216. i : byte;
  217.  
  218. begin
  219. st := '';
  220. setrgb(0,0,0,0);
  221. setrgb(1,0,0,0);
  222. setrgb(2,0,0,0);
  223. index := 0;
  224. fin := false;
  225. add1 := 0;
  226. add2 := 0;
  227.  
  228. for n := 1 to 14 do
  229. print(0,n+16,logo[n],1);
  230.  
  231. for n := 1 to 8 do
  232. print(0,n+40,number[n],1);
  233. for n := 1 to 8 do
  234. print(0,n+1,number[n],1);
  235. sc_i := 1;
  236.  
  237.  
  238. for n := 0 to 10 do
  239. begin
  240. setrgb(0,n*4,n*3,n*4);
  241. setrgb(1,n*4,n*3,n*4);
  242. setrgb(2,n*4,n*3,n*4);
  243. wait_vbl;
  244. end;
  245.  
  246. for n := 0 to 20 do
  247. begin
  248. wait_vbl;
  249. setrgb(1,40+n,30+n,40+n);
  250. setrgb(2,40-(n shr 1),30-(n shr 1),40-(n shr 1));
  251. end;
  252. randomize;randomize;
  253. for n := 1 to random(20) do randomize;
  254.  
  255. { boucle principale }
  256. repeat
  257. begin
  258. wait_vbl;
  259. inc(n);
  260. if (n mod 200 ) = 0 then begin
  261.                        phi := n;
  262.                        add1 := random(5)+1;
  263.                        add2 := random(5)+1;
  264.                        end;
  265.  
  266.  
  267. i := 2+( sinus[n  and 255] )div 3;
  268. for m := 1 to max do
  269. print(i,pos[m],texte[m],1);  { LAME !! }
  270.  
  271. sc_i := (sc_i+1) and 127;
  272. st := copy(scroll,sc_i,28);
  273. print(25,13,'['+st+']',1);
  274.  
  275. do_vagues;
  276.  
  277.  
  278. { quitte si ESC appuyé }
  279. asm
  280.    in   al,60h
  281.    cmp  al,1
  282.    jne  @fin_KKK
  283.    mov  fin,true
  284. @fin_KKK:
  285. end;
  286.  
  287. end;
  288. until fin  = true;
  289.  
  290. { vide le buffer de clavier }
  291. asm
  292. @debut:
  293.     mov ax,0100h
  294.     int 16h
  295.     jz  @fin
  296.     xor ax,ax
  297.     int 16h
  298.  
  299.     jmp @debut
  300.     @fin:
  301. end;
  302.  
  303. end;
  304.  
  305. procedure endtro;
  306. begin
  307. asm
  308.      mov        ax,0003h
  309.      int        10h
  310. end;
  311. setrgb(7,0,0,0);
  312. for n := 1 to 154 do write('LiTHiUM bbs  ');
  313. writeln('Code, Ascii by impulse / KNIGHTS ');
  314. print(30,12,'    LITHIUM  bbs    ',0+16*7);
  315. print(0,13,'                               KNIGHTS Belgium HQ                               ',0+16*7);
  316. print(30,14,'  (32)-65-63-37-32  ',0+16*7);
  317.  
  318. for n := 0 to 63 do
  319. begin
  320. wait_vbl;
  321. wait_vbl;
  322. setrgb(7,n,n,n);
  323. end;
  324. for n := 63 downto 40 do
  325. begin
  326. wait_vbl;
  327. wait_vbl;
  328. setrgb(7,n,n,n);
  329. end;
  330.  
  331. end;
  332.  
  333.  
  334.  
  335.  
  336. begin
  337.  
  338.      asm
  339. { Verifie si VGA }
  340.         mov  ax,01a00h
  341.         int  10h
  342.         cmp  al,1ah
  343.         je  @suite
  344.         mov ax,4c00h
  345.         int 21h
  346.  
  347. @suite:
  348. { passe en mode 80*50 }
  349.         mov     ax,0003h
  350.         int     10h
  351.         mov     ax,1112h
  352.         mov     bx,0000h
  353.         int     10h
  354.      end;
  355.      init_curseur;
  356.  
  357.  
  358.      intro;
  359.      endtro;
  360.  
  361. end.