home *** CD-ROM | disk | FTP | other *** search
/ Intermedia 1998 January / inter1_98.iso / www / rozi / WAVE.ZIP / WAVE.PAS < prev   
Pascal/Delphi Source File  |  1997-01-23  |  2KB  |  97 lines
  1. {$G+}
  2. USES CRT;
  3. CONST vseg : WORD   = $a000;
  4.       txt  : STRING = 'TYTUS SOFTWARE 1997    Tomek Rozenberg';
  5.                    (*  12345678901234567890123456 78901234567890 *)
  6.       txt1 : STRING = '   Czestochowa      tel. 034 247205   ';
  7. VAR stab      : ARRAY[0..255] OF BYTE;
  8.     fseg,fofs : WORD;
  9. PROCEDURE getfont; ASSEMBLER;
  10.   ASM
  11.     mov ax,1130h;
  12.     mov bh,1;
  13.     int 10h;
  14.     mov fseg,es;
  15.     mov fofs,bp;
  16.   END;
  17. PROCEDURE csin;
  18.   VAR i : BYTE;
  19.   BEGIN
  20.     for i := 0 to 255 do stab[i] := round(sin(6*i*pi/255)*25)+40;(*150*)
  21.   END;
  22. PROCEDURE clear(x,y: WORD); ASSEMBLER;
  23.   ASM
  24.     mov es,vseg
  25.     mov dx,0
  26.    @lout:
  27.     mov cx,0
  28.    @lin:
  29.     mov ax,y
  30.     add ax,dx
  31.     shl ax,6
  32.     mov di,ax
  33.     shl ax,2
  34.     add di,ax
  35.     add di,x
  36.     add di,cx
  37.     xor ax,ax
  38.     mov [es:di],ax
  39.     add cx,2
  40.     cmp cx,8
  41.     jne @lin
  42.     inc dx
  43.     cmp dx,2 (* Was 8 *)
  44.     jne @lout
  45.   END;
  46. PROCEDURE writechar(ch: CHAR; x,y: WORD; col: BYTE);
  47.   VAR j,k : BYTE;
  48.       pre : WORD;
  49.       opt : WORD;
  50.   BEGIN
  51.     pre := BYTE(ch)*8; (* Opt *)
  52.     clear(x,y-2);      (* Key *)
  53.     FOR j:=0 TO 7 DO
  54.       FOR k:=0 TO 7 DO
  55.         BEGIN
  56.           opt := (y+j)*320+x+k;  (* Opt *)
  57.           IF ((MEM[fseg:fofs+pre+j] SHL k) AND 128)=0 THEN
  58.             MEM[$a000:opt] := 0 (* Key *)
  59.           ELSE
  60.             MEM[$a000:opt] := col;
  61.         END;
  62.     INC(y,8);   (* Opt *)
  63.     clear(x,y); (* Key *)
  64.   END;
  65. PROCEDURE dodycp;
  66.   VAR sctr,i,l: BYTE;
  67.       a,b,c : WORD;
  68.   BEGIN
  69.     sctr := 0;
  70.     l := LENGTH(txt); (* Opt *)
  71.     REPEAT
  72.       WHILE (PORT[$3da] AND 8)<>0 DO;
  73.       WHILE (PORT[$3da] AND 8)=0 DO;
  74.       FOR i := 1 TO l DO
  75.         BEGIN
  76.           a := i*8;
  77.           b := stab[(sctr+2*i) MOD 255];
  78.           c := stab[sctr+i] MOD 64;
  79.           INC(c,32);
  80.  
  81.           writechar(txt[i],a,b,c);
  82.           INC(b,110);
  83.           writechar(txt1[i],a,b,c);
  84.         END;
  85.       INC(sctr);
  86.     UNTIL KEYPRESSED;
  87.   END;
  88. BEGIN
  89.   getfont;
  90.   csin;
  91.   ASM
  92.     mov ax,13h;
  93.     int 10h;
  94.   END;
  95.   dodycp;
  96.   TEXTMODE(lastmode);
  97. END.