home *** CD-ROM | disk | FTP | other *** search
/ The Equalizer BBS / equalizer-bbs-collection_2004.zip / equalizer-bbs-collection / DEMOSCENE-STUFF / TUC_TD10.ZIP / TUC_TEST.PAS < prev   
Pascal/Delphi Source File  |  1994-03-16  |  10KB  |  264 lines
  1. {                   (c) CopyRight 1993,94 by Freaker! ■ TuC
  2. ==============================================================================
  3. Help about command's
  4. ------------------------------------------------------------------------------
  5. {-} {procedure/function in TUC_TEST.PAS
  6. {*} {procedure/function in TUC_DEMO.TPU
  7. {/} {procedure/function of Turbo Pascal
  8. {!} {NEEDED procedure/function of TUC_DEMO.TPU
  9. ==============================================================================
  10. Internal procedures/functions ...
  11. ------------------------------------------------------------------------------
  12. procedure TUC_HSCINIT;                      [NEEDED when using HSC routines !]
  13.  ≡ Use this when you use the HSC routines (required)
  14. procedure TUC_HSCCLOSE(fadehsc:boolean);  [CLOSE HSC ROUTINES/only if HSCINIT]
  15.  ≡ Use this to DEinitialize the hsc routines   (true=fade music/false=no fade)
  16. procedure TUC_PLAYHSCBACK;                       [Play HSC file in background]
  17.  ≡ Use this to play the HSC file AFTER blockwrite !
  18. ------------------------------------------------------------------------------
  19. procedure TUC_FADEINIT;                  [NEEDED when using FADING ROUTINES !]
  20.  ≡ Use this when use of the FADING routines (required)
  21. procedure TUC_FADECLOSE;              [CLOSE FADE ROUTINES · only if FADEINIT]
  22.  ≡ Use this to DEinitialize the fading routines
  23. Procedure TUC_FADEOUT(Speed : Integer);                      [FADE screen out]
  24.  ≡ Fade out (delay in milliseconds)
  25. Procedure TUC_FADEIN(Speed : Integer);                        [FADE screen in]
  26.  ≡ Fade in (delay in milliseconds)
  27. ------------------------------------------------------------------------------
  28. procedure TUC_FLUSHKEYBOARD;                           [Flush keyboard buffer]
  29.  ≡ flush keyboard buffer (after readkey/keypressed for example)
  30. function  TUC_READKEY:char;                                          [READKEY]
  31.  ≡ READ key ,returns "char" as result
  32. function  TUC_KEYPRESSED:boolean;                                 [KEYPRESSED]
  33.  ≡ KEYPRESSED ,returns TRUE if pressed any key
  34. ------------------------------------------------------------------------------
  35. PROCEDURE TUC_CURSOROFF;                                     [Turn cursor OFF]
  36.  ≡ Turn cursor OFF
  37. PROCEDURE TUC_CURSORON;                                       [Turn cursor ON]
  38.  ≡ Turn cursor ON
  39. ------------------------------------------------------------------------------
  40. procedure TUC_TSCRESET;                            [TINY SCROLLER SPEED RESET]
  41.  ≡ RESET the speed of the TINY scroller
  42. procedure TUC_TSC(str:string;xloc,yloc:integer;rand:boolean);  [TINY SCROLLER]
  43.  ≡ put scroller on screen in following format:
  44.    TUC_TSC("STRING TO SHOW",X-AXIS,Y-AXIS,TRUE/FALSE); where TRUE/FALSE is
  45.    random color scroller or just WHITE scroller
  46.          (or color defined with TUC_TSC_COLOR:=byte of color)
  47. procedure tuc_ssc_init;                                   [SMOOTHSCROLL RESET]
  48.  ≡ RESET ssc scroller (NECCESARY BEFORE STARTING THIS SCROLLER AGAIN !)
  49. procedure tuc_ssc(txt:string;row,yax1,yax2,attr:byte);        [SMOOTHSCROLLER]
  50.  ≡ TUC_SSC("STRING TO SHOW",X-AXIS,Y-AXIS<to start>,Y-AXIS<to end>,attribute);
  51. ------------------------------------------------------------------------------
  52. procedure TUC_HILITE(OnOff:boolean);                            [BLINK on/off]
  53.  ≡ HILITE characters (blink on/off)
  54. procedure TUC_QWRITE(xx,yy:byte;str:string;fc,bc:byte);           [QUICKWRITE]
  55.  ≡ QUICK WRITE (without CR)
  56. procedure TUC_QWRITELN(xx,yy:byte;str:string;fc,bc:byte);       [QUICKWRITELN]
  57.  ≡ QUICK WRITE (with CR)
  58.    xx,yy is X-axis and Y-axis
  59.    str is the string to write
  60.    fc,bc are foreground color and background color
  61. procedure TUC_SWITCHMAP;                                        [SWITCHCHRMAP]
  62. Procedure TUC_SWITCHMAP_RESET;
  63. ==============================================================================
  64. Costumisable parameters
  65. ------------------------------------------------------------------------------
  66. const TUC_TSC_CHARDELAY : integer = 6;    (character delay TSC scroller in mS)
  67.       TUC_TSC_ENDDELAY  : integer = 800;   (enddelay after TSC scroller in mS)
  68.       TUC_TSC_COLOR     : byte    = 15;  (color of TSC scroller if non-random)
  69.     TUC_SWITCHMAP_STATUS: boolean = false;   (switchmap status / auto updated)
  70. }
  71.  
  72.  
  73. uses crt,tuc_demo;
  74.  
  75. var key     : char;                      {needed for the "H"ilite key}
  76.     counter : byte;                      {needed for the scroll-up}
  77.  
  78.  
  79. PROCEDURE hscfile; external;
  80. {$L m.obj}   {use BINOBJ to convert an HSC to an OBJ file by typing}
  81.              {BINOBJ FILENAME.HSC M.OBJ HSCFILE                    }
  82.  
  83. procedure HSC_PLAYER;
  84. begin
  85.    tuc_hscinit;                        {initialisation of the HSC routine }
  86.    BLOCKWRITE(fhsc, @hscfile^, {!!}14259+1{!! the size of your HSC file});
  87.    tuc_playhscback;                    {needed to play in background      }
  88. end;
  89.  
  90.  
  91. Procedure SCROLL_DEMO1;
  92. begin
  93.  
  94. tuc_tsc('This is an simple scroller... without random colors ...',1,10,false);
  95. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  96. tuc_tsc_color:=random(14+1);
  97. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  98. tuc_tsc_color:=random(14+1);
  99. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  100. tuc_tsc_color:=random(14+1);
  101. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  102. tuc_tsc_color:=random(14+1);
  103. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  104. tuc_tsc_color:=random(14+1);
  105. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  106. tuc_tsc_color:=random(14+1);
  107. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  108. tuc_tsc_color:=random(14+1);
  109. tuc_tsc('-------------again one .. in another color ...---------',1,10,false);
  110. tuc_tsc_color:=random(14+1);
  111.  
  112. tuc_tsc('This is an simple scroller... with random colors ...',1,11,true);
  113. tuc_tsc('Anywhere on the screen !     ',8,15,true);
  114. tuc_tsc('Anywhere on the screen !     ',10,5,true);
  115. tuc_tsc('Anywhere on the screen !     ',2,3,true);
  116. end;
  117.  
  118. procedure SCROLL_DEMO2;
  119. begin
  120. tuc_tsc('With cursor off !                 ',8,15,true);
  121.   delay(2000);
  122.   tuc_cursoron;
  123. tuc_tsc('With cursor back on ....          ',8,15,true);
  124. tuc_tsc('How to wipe this line away ?      ',8,15,true);
  125.   delay(2000);
  126. tuc_tsc('                                  ',8,15,true);
  127. tuc_tsc('Now it''s here .....               ',2,1,true);
  128. tuc_tsc('                                  ',2,1,true);
  129. tuc_tsc('Now it''s here ..... again         ',2,1,true);
  130. tuc_tsc('                                  ',2,1,true);
  131. tuc_tsc('See ? easy to remove line !!!     ',2,1,true);
  132. tuc_tsc('                                  ',2,1,true);
  133. end;
  134.  
  135. procedure SCROLL_DEMO3;
  136. begin
  137. tuc_tsc('And .. of course .. control speed with the parameter CHARDELAY/ENDDELAY ',8,15,true);
  138. delay(2000);
  139. TUC_TSC_CHARDELAY := 2;
  140. TUC_TSC_ENDDELAY  := 2000;
  141. tuc_tsc('This is faster scroller with delay after it ... (2ms char/2sec delay) ',1,1,true);
  142. tuc_tscreset;
  143. tuc_tsc('This is the normal speed ...                                          ',1,1,true);
  144.   delay(2000);
  145. tuc_tsc('Now switching character maps 4 times                                   ',8,15,true);
  146. TUC_SWITCHMAP;
  147. delay(300);
  148. TUC_SWITCHMAP;
  149. delay(300);
  150. TUC_SWITCHMAP;
  151. delay(300);
  152. TUC_SWITCHMAP;
  153. delay(300);
  154. (*TUC_SWITCHMAP;
  155. delay(300);*)
  156. TUC_SWITCHMAP;
  157. delay(300);
  158. TUC_SWITCHMAP;
  159. delay(300);
  160. TUC_SWITCHMAP;
  161. delay(300);
  162. end;
  163.  
  164. procedure smooth_scroll;
  165. var line,counter2:integer;
  166.  
  167. begin
  168. clrscr;
  169. randomize;
  170. counter:=1;
  171. line:=1;
  172. repeat
  173. gotoxy(1,line);
  174. for counter:=counter+1 to 80 do write(random(255));
  175. counter:=1;
  176. line:=line+1;
  177. until line=24;
  178. tuc_ssc_init;
  179. repeat
  180. tuc_ssc('         This is an fine scrolly from line 2 to line 79 ... smooth ! uh ! yeah ... also this is in this unit ...   '+
  181.         '                   ',12,2,79,$1F);
  182. until keypressed;
  183. end;
  184.  
  185.  
  186. Procedure write_demo;
  187. begin
  188.    gotoxy(1,24);
  189. write('This is an ordinary gotoxy with write ... ');
  190.    delay(500);
  191. tuc_qwrite(1,20,'This is quickwrite',$0E);
  192.    delay(500);
  193. tuc_qwrite(1,1,'Press any key to continue ... ',$0E);
  194. end;
  195.  
  196. procedure hi_demo;
  197. begin
  198. TUC_HILITE(false);
  199. tuc_qwrite(1,1,'Here is an HILITE demo ... ehehe .. yeah !        -touch tha key                ',$4F);
  200. tuc_qwrite(1,2,'Press now "H" to turn the hi-bits on ...                              1234567890',$7E+blink);
  201. tuc_qwrite(1,3,'     Press now "H" to turn the hi-bits on ...                         1234567890',$4F+blink);
  202. tuc_qwrite(1,4,'          Press now "H" to turn the hi-bits on ...                    1234567890',$1F+blink);
  203. tuc_qwrite(1,5,'               Press now "H" to turn the hi-bits on ...               1234567890',$1E+blink);
  204. tuc_qwrite(1,6,'                    Press now "H" to turn the hi-bits on ...          1234567890',$1B+blink);
  205.    repeat
  206.        key:=tuc_readkey;
  207.    until upcase(key) = 'H';
  208. TUC_SWITCHMAP;
  209. tuc_qwrite(1,15,'Press now any key to return to normal mode ...',$4F+blink);
  210. TUC_HILITE(false);
  211. textbackground(black);
  212.  
  213. tuc_tsc('And going back to NORMAL MODE ...   press a key to quit this quick demo ...',1,15,true);
  214.  
  215.    delay(2000);
  216.    tuc_cursoron;
  217.    TUC_HILITE(true);
  218. end;
  219.  
  220. procedure fadeout;
  221. begin
  222. tuc_fadeout(10);
  223. clrscr;
  224. tuc_fadein(1);
  225. writeln('That''s all folks !');
  226. end;
  227.  
  228.  
  229. {-} {procedure/function in TUC_TEST.PAS}
  230. {*} {procedure/function in TUC_DEMO.TPU}
  231. {/} {procedure/function of Turbo Pascal}
  232. {!} {NEEDED procedure/function of TUC_DEMO.TPU}
  233.  
  234. begin
  235. {-} hsc_player;
  236. {*} tuc_fadeinit;
  237. {/} clrscr;
  238. {-} scroll_demo1;
  239. {*} tuc_cursoroff;
  240. {-} scroll_demo2;
  241. {-} write_demo;
  242. {*} repeat until keypressed;
  243. {/} clrscr;
  244. {-} scroll_demo3;
  245. {*} TUC_TSCRESET;
  246. {*} repeat until keypressed;
  247. {/} clrscr;
  248. {-} hi_demo;
  249. {*} tuc_flushkeyboard;
  250. {*} repeat until keypressed;
  251. {*} tuc_flushkeyboard;
  252. {-} smooth_scroll;
  253. {-} fadeout;
  254. {!} tuc_fadeclose;
  255. {!} tuc_hscclose(true);
  256. {!} tuc_switchmap_reset;
  257. end.
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.