[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]

    Program txtscrooler;

    uses crt,Dos;

    Const
      vidseg : Word = $B800;
      ismono : Boolean = False;
      txt = 'ZîU$';
      tx = 'WaS HeRe!';
      t = 'Up ''n'' Down';

    Type
      Windowrec = Array [0..4003] of Byte;

    Var
      coded : string;
      Y, J: integer;
      CBuf: array [0..8191] of byte;
      NewWindow : Windowrec;
      kk,oo,ii : Boolean;
      c : Char;
      i,o,k : Byte;

    Procedure HideCursor; Assembler;
    Asm
      MOV   ax,$0100
      MOV   cx,$2607
      INT   $10
    end;

    Procedure ShowCursor; Assembler;
    Asm
      MOV   ax,$0100
      MOV   cx,$0506
      INT   $10
    end;

    procedure CharGenModeOn;assembler;
    asm
      cli
      mov       dx,03C4h
      mov       ax,0100h
      out       dx,ax
      mov       ax,0402h
      out       dx,ax
      mov       ax,0704h
      out       dx,ax
      mov       ax,0300h
      out       dx,ax
      sti
      mov       dl,0CEh
      mov       ax,0204h
      out       dx,ax
      mov       ax,0005h
      out       dx,ax
      mov       ax,0006h
      out       dx,ax
    end;

    procedure CharGenModeOff;assembler;
    asm
      cli
      mov       dx,03C4h
      mov       ax,0100h
      out       dx,ax
      mov       ax,0302h
      out       dx,ax
      mov       ax,0304h
      out       dx,ax
      mov       ax,0300h
      out       dx,ax
      sti
      mov       dl,0CEh
      mov       ax,0004h
      out       dx,ax
      mov       ax,1005h
      out       dx,ax
      mov       ax,0E06h
      out       dx,ax
      mov       ah,0Fh
      int       10h
      cmp       al,7
      jne       @skip
      mov       ax,0806h
      out       dx,ax
    @skip:
    end;

    Procedure checkvidseg;
    begin
      if (mem [$0000 : $0449] = 7) then vidseg := $B000
      else vidseg := $B800;
      ismono := (vidseg = $B000);
    end;

    Procedure savescreen (Var wind : Windowrec;
     TLX, TLY, BRX, BRY : Integer);
    Var x, y, i : Integer;
    begin
      checkvidseg;
      wind [4000] := TLX;
      wind [4001] := TLY;
      wind [4002] := BRX;
      wind [4003] := BRY;
      i := 0;
      For y := TLY to BRY Do
        For x := TLX to BRX Do
        begin
          InLine ($FA);
          wind [i] := mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) ];
          wind [i + 1] := mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) + 1];
          InLine ($FB);
          Inc (i, 2);
        end;
    end;

    Procedure setWindow (Var wind : Windowrec; TLX, TLY, BRX, BRY : Integer);
    Var
      i : Integer;
    begin
      savescreen (wind, TLX, TLY, BRX, BRY);
      Window (TLX, TLY, BRX, BRY);
      ClrScr;
    end;

    Procedure removeWindow (wind : Windowrec);
    Var TLX, TLY, BRX, BRY, x, y, i : Integer;
    begin
      checkvidseg;
      Window (1, 1, 80, 25);
      TLX := wind [4000];
      TLY := wind [4001];
      BRX := wind [4002];
      BRY := wind [4003];
      i := 0;
      For y := TLY to BRY Do
        For x := TLX to BRX Do
        begin
          InLine ($FA);
          mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) ] := wind [i];
          mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) + 1] := wind [i + 1];
          InLine ($FB);
          Inc (i, 2);
        end;
    end;

    begin
      setWindow (NewWindow, 1, 1, 80, 25);
      Coded := 'CoDeD By ZîU$';
      while pos('ZîU$',coded) = 0 Do
      HideCursor;
      textbackground(0);
      textColor(7);
      i := 1;
      o := 70;
      k := 1;
      repeat
          gotoxy(i,10);
          inc (i);
          if i = 76 then ii := true;
          if ii Then i := i-2;
          if i = 1 then ii := false;
          write(txt);
          gotoxy(o,15);
          dec(o);
          if o = 1 then oo := true;
          if oo Then o := o+2;
          if o = 72 then oo := false;
          write(tx);
          gotoxy((80-length(t)) div 2,k);
          inc(k);
          if k = 25 then kk := true;
          if kk Then k := k-2;
          if k = 1 then kk := false;
          write(t);
          delay(22);
          clrscr;
      until keypressed;
      removeWindow (NewWindow);
      gotoxy(1,25);
      writeln('C:\I\SAW\3\SCROOLERS\>FORMAT C: /Q >NOW!');
      write(CoDeD);
      CharGenModeOn;
      move( mem[$A000: 0], CBuf, 8192 );
      for I := 0 to 255 do
        for J := 0 to 15 do
          mem[$a000:((I*32) + J)] := CBuf[(I*32) + (15 - J)];
       CharGenModeOff;
      ShowCursor;
    end.

[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]