home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / tv.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-29  |  2KB  |  70 lines
  1. {$M 1024,0,64000}  (* 1 K Stack, 64 K Heap (Used for VID Mem) *)
  2.  
  3. Program TelevisionSimulator;
  4.  
  5. (*
  6.    This has been written by Kevin Keenliside (Pyromaniax of SKP), and I
  7.    have decided to release this source code to the public. Feel free to
  8.    use this source in your programs. No credit is necessary, but is much
  9.    appreciated.
  10. *)
  11.  
  12. Type
  13.   Video = ^VideoPTR;
  14.   VideoPtr = Array[0..64000] of Char;   (* Pointer Array, breaks the 64kb
  15.                                            limit so this is conceivable *)
  16.  
  17. Var
  18.   VideoArray : Video;                   (* Variable = Pointer Array *)
  19.   T,RanColor : byte;
  20.  
  21. Procedure SetMode(M : word); assembler; (* Set Video Mode *)
  22. Asm
  23.   Mov ax,M
  24.   Int 10h
  25. End;
  26.  
  27. Procedure PalSet(Color, Rc, Bc, Gc : Byte; TMode : Boolean);
  28. Begin
  29.   If (Tmode) and (Color>7) then Inc(Color,48);
  30.   Port[$3C8] := Color;
  31.   Port[$3C9] := Rc;
  32.   Port[$3C9] := BC;
  33.   Port[$3C9] := GC;
  34. End;
  35.  
  36. Function KeyHit : Boolean;
  37. Begin
  38.   If Port[$60]<$80 then KeyHit:=True
  39.   else
  40.   KeyHit:=False;
  41. End;
  42.  
  43. Procedure PutRandomDots(Var Scr : Array of Char);
  44. Var
  45.   I : Longint;
  46.  
  47. Begin
  48.   For I:=0 to SizeOf(Scr) do Scr[I]:=Chr(Random(15)+17); (* Fill Array with
  49.                                                             color Numbers *)
  50.   Move(Scr,Mem[$A000:$0000],SizeOf(Scr));                (* Move array to
  51.                                                             video memory  *)
  52. End;
  53.  
  54. {**** Main Program *********************************************************}
  55.  
  56. Begin
  57.   SetMode($13);                                     (* Put in 320x200 mode *)
  58.   GetMem(VideoArray,SizeOf(VideoArray^));           (* Allocate another 64k*)
  59.   PutRandomDots(VideoArray^);                       (* Fill array with dots*)
  60.   FreeMem(VideoArray,SizeOf(VideoArray^));          (* Free used 64k       *)
  61.   Repeat
  62.     If (T>=15) and (T<=32) then Inc(T) else T:=15;  (* Pick color to change*)
  63.     RanColor:=Random(31);                           (* Set intensity of Clr*)
  64.     PalSet(T,RanColor,RanColor,RanColor,False);     (* Change the Palette  *)
  65.   Until KeyHit;                                     (* Repeat until Keyhit *)
  66.   SetMode($3);                                      (* Put in 80x25 T Mode *)
  67. End.
  68.  
  69. {**** End of Program *******************************************************}
  70.