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

{Ribbon scroller...programmed by Glen Jeh in Turbo Pascal 7.0, 4/24/94
 Use freely}

{$R+}
program RibbonScroll;  {this is IT}
uses Crt, Dos;

     { I turned on range checking to slow it down :) }

const
  YLocation = 100;  {position on the screen...}
  Constant = 8;     {mess with this to use different parts of the curve}
  Radius = 30;      {this is how big of a curve you want}
  Width  = 10;      {wrong name..this is actually the waviness of the curve}
  Spacing = 4;      {this is how fat the chars will be..or something}
  Height = 1.5;     {this is how tall each character will be}
  DispStr : string = 'Adjust the above constants <WRAP>...   ';

  Rows   = 8; {don't change this}

{testing}
type
  CharType = array[1..8] of Byte;
  PathType = array[1..320 div Spacing] of
    record
      Pos : Word; {position in memory}
      On  : Boolean; {on or off?}
    end;
             {this keeps track of the Y-Pos of the dot at X}
var
  CharSet : array[0..255] of CharType absolute $F000:$FA6E;
  PathArray : array[1..Rows] of PathType;
  I,
  I2,
  DispLine : Integer;

function GetNext(Row : Integer) : Boolean;
var
  CharNum,
  ColumnNum : Integer;
begin
  CharNum := DispLine div 8 + 1;
  ColumnNum := DispLine mod 8 + 1;
  GetNext := CharSet[Ord(DispStr[CharNum])][Row] shr (8 - ColumnNum) and 1 = 1;
end;


function F(X:Real): Real;
begin
  F := (Sin ((X + Constant) / Width) * Radius + YLocation)
end;


procedure Mode(B : Byte);
var
  Regs : Registers;
begin
  Regs.ah := 0;
  Regs.al := B;
  Intr($10,Regs);
end;

procedure BuildPath;
begin
  for I := 1 to Rows do
    for I2 := 1 to 320 div Spacing do
      begin
        PathArray[I][I2].Pos := Round(F(I2+Height*I));
          {compute Y location first}

        PathArray[I][I2].Pos :=
          (PathArray[I][I2].Pos - 1) * 320 + (I2 * Spacing) - 1;
          {compute memory location}
      end
end;


begin
  Mode($13);
  BuildPath;
  DispLine := 1;
  repeat
    repeat until (Port[$3DA] and $08) <> 0;
    for I := 1 to 8 do
      begin
        for I2 := 1 to (320 div Spacing) - 1 do
          PathArray[I][I2].On := PathArray[I][I2 + 1].On;
        PathArray[I][320 div Spacing].On := GetNext(I);
        for I2 := 1 to 320 div Spacing do
          if PathArray[I][I2].On then
            Mem[$A000:PathArray[I][I2].Pos] := I2 mod (100 - 50) + 50
          else
            Mem[$A000:PathArray[I][I2].Pos] := 0;
      end;
    Inc(DispLine);
    if DispLine = 8 * Length(DispStr) then
      DispLine := 1;
  until KeyPressed;
  Mode($3);
end.

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