{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                            BLANKER SCROLLTEXT                             Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί                GENERATED BY MRE (MOS RESOURCE EDITOR) v2.8                Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί Coded by Zuul as BouFFtou as Cheveau Fr‚d‚ric.                            Ί
 Ί Source Turbo Pascal v7.00 generated by MRE (MOS Resource Editor) v3.0.    Ί
 Ί Contact us on MOS Home's Page - http://www.multimania.com/mos             Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

{$M 65500,0,365520}                     {*Stack And Heap*}
{$N+}                                   {*8087 Emulation Mode*}
{$R- $Q-}

Program SCROLLTEXT;                     {*Program Name*}

Uses Dos,                               {*Unit BP7 DOS*}
     MOS_DEB, MOS_VESA,
     MOS_GPH, MOS_KBD,
     MOS_STR, MOS_BLK,
     MOS_CRT, MOS_BAS,                  {*Manage Initialisations and CRT*}
     MOS_ASM, MOS_MSE,                  {*Manage Assembler and Mouse*}
     MOS_IPX, MOS_XMS,                  {*Manage Networks and XMS Memory*}
     MOS_TOO, MOS_GAD,                  {*Manage Tools and Gadgets*}
     MOS_GFX, MOS_BMP,                  {*Manage Graphics and BMP*}
     MOS_WIN, MOS_MEN,                  {*Manage Windows and Menus*}
     MOS_WAV, MOS_VAR,                  {*Manage WAV Sounds*}
     MOS_DIR, MOS_SYS,                  {*Manage Disk and System*}
     MOS_TSK, MOS_LIS,
     MOS_REQ, MOS_FIL,
     MOS_SWAP;                          {*Manage Requesters and Swap Disk*}

Var Par            :String;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

const
  GSeg = $a000;
  Slen = 255;
  Ymax =7;

Type SinArray = array[0..Slen] of word;
Var Stab : SinArray; Fseg,Fofs : word;
    Sofs,Samp,Size,Curve,ScrSpd,Shrunk,XMax:Longint;
    ScrText:String;

{****************************************************************************}

Procedure INIT_PARAM;
Begin
Sofs:=80;  Samp:=10;
Size:=3;   Curve:=0;
ScrSpd:=2; Shrunk:=4;
XMax:=279 div Size;
ScrText:='Hello world, Welcome to MOS and have a nice day...              ';
End;

{****************************** SAVE PARAMETERS *****************************}

Procedure SAVE_PARAM;
Var Fil1:Text;
Begin
Assign(Fil1,'SCROLTXT.CFG');
{$I-}
Rewrite(Fil1);
{$I+}
If IOResult=0 Then Begin
   Writeln(Fil1,'[Scrolltext]');
   Writeln(Fil1,'Message (',ScrText,')');
   Writeln(Fil1,'Vertical Position (',Sofs,')');
   Writeln(Fil1,'Font Size (',Size,')');
   Writeln(Fil1,'Sinus Amplitude (',Samp,')');
   Writeln(Fil1,'Text Rotation (',Curve,')');
   Writeln(Fil1,'Ondulation Speed (',ScrSpd,')');
   Writeln(Fil1,'Ondulation Distortion (',Shrunk,')');
   Close(Fil1);
   End;
End;

{****************************** SAVE PARAMETERS *****************************}

Procedure LOAD_PARAM;
Var LineReaded:Integer;
    Fin,Skip:Boolean;
    St,StC,FName,StVal:String;
    P1,P2,Code:Integer;                 {*Position "(" et ")"*}

Begin
FName:='SCROLTXT.CFG';
LineReaded:=File_TestString(FName,'[Scrolltext]',0);
If LineReaded=0 Then Exit;              {*File not Found or Incorrect file*}
Fin:=FALSE;

   Repeat                               {*Parcours toutes les lignes d'Initialisation*}
   St:=File_GetLine(FName,LineReaded);
   StC:=St;
   St:=Upper(St);
   If LineReaded>File_CountLines(FName) Then Fin:=TRUE;
   P1:=Pos('(',St); P2:=Pos(')',St);
   StVal:=Copy(St,P1+1,P2-P1-1);
   StC:=Copy(StC,P1+1,P2-P1-1);
   Skip:=FALSE;
   If Copy(St,1,3)='REM' Then Skip:=TRUE;{*Ligne en REM*}
   If (Not Fin) And (Not Skip) Then Begin
      If Pos('MESSAGE',St)>0 Then ScrText:=StC;
      If Pos('VERTICAL POSITION',St)>0 Then Val(StVal,Sofs,Code);
      If Pos('FONT SIZE',St)>0 Then Val(StVal,Size,Code);
      If Pos('SINUS AMPLITUDE',St)>0 Then Val(StVal,Samp,Code);
      If Pos('TEXT ROTATION',St)>0 Then Val(StVal,Curve,Code);
      If Pos('ONDULATION SPEED',St)>0 Then Val(StVal,ScrSpd,Code);
      If Pos('ONDULATION DISTORTION',St)>0 Then Val(StVal,Shrunk,Code);
      End;
   Inc(LineReaded);                     {*Next Line...*}
   Until Fin;
End;

{******************************** MAKE SCROLL *******************************}

procedure CalcSinus; var I : word; begin
  for I := 0 to Slen do Stab[I] := round(sin(I*Shrunk*Pi/Slen)*Samp)+Sofs; end;

procedure GetFont; assembler; asm
  push bp;mov ax,1130h; mov bh,3; int 10h; mov Fseg,es; mov Fofs,bp;
  pop bp;end;

procedure SetGraphics(Mode : word); assembler; asm
  mov ax,Mode; int 10h end;

procedure Scroll;
type
  ScrArray = array[0..279{Xmax},0..Ymax] of byte;
  PosArray = array[0..279{Xmax},0..Ymax] of word;
var
  PosTab : PosArray;
  BitMap : ScrArray;
  X,I,SinIdx : word;
  Y,ScrIdx,CurChar : byte;
  Action:TAction;

Begin
  fillchar(BitMap,sizeof(BitMap),0);
  fillchar(PosTab,sizeof(PosTab),0);
  ScrIdx := 1; SinIdx := 0;

  Test_AnythingActioned(Action,C_Init);
  repeat
    Curchar := ord(ScrText[ScrIdx]);
    inc(ScrIdx); if ScrIdx = length(ScrText) then ScrIdx := 1;
    for I := 0 to 7 do begin
      move(BitMap[1,0],BitMap[0,0],(Ymax+1)*Xmax);
      for Y := 0 to Ymax do
        if ((mem[Fseg:Fofs+8*CurChar+Y] shl I) and 128) <> 0 then
          BitMap[Xmax,Y] := ((ScrIdx+Y-I) mod 60)+32 else BitMap[Xmax,Y] := 0;
      while (port[$3da] and 8) <> 0 do;
      while (port[$3da] and 8) = 0 do;
      for X := 0 to Xmax do
        for Y := 0 to Ymax do begin
          mem[GSeg:PosTab[X,Y]] := 0;
          PosTab[X,Y] := (Size*Y+STab[(SinIdx+X+Curve*Y) mod SLen])*320+Size*X+STab[(X+Y) mod SLen]-SOfs;
          mem[GSeg:PosTab[X,Y]]:=BitMap[X,Y];
        end;
      SinIdx := (SinIdx+ScrSpd) mod SLen;
    end;
  until Test_AnythingActioned(Action,C_Execute);
end;

Procedure Blk_Anim;
begin
  CalcSinus;
  GetFont;
  SetGraphics($13);
  Scroll;
end;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                          PROCEDURE Blk_Parameters                         Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί EXPLAIN: Parameter Blanker Animation.                                     Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Procedure Blk_Parameter(Px,Py:Integer);
Const MaxCom=6;                         {*Maximum and minimum of values*}
      TMax:Array[1..MaxCom] of Integer=(160,10,50,10,5, 10);
      TMin:Array[1..MaxCom] of Integer=(20, 1, 0, 0, -5,2 );

Var W1            :TWindow;             {*Window Structure*}
    Even          :Byte;                {*Get Windows Evens*}
    XOk,XCancel   :Boolean;             {*Exit Flags*}
    But1,But2,But3:TButton;
    Com1          :TInputText;
    TIS           :Array[1..MaxCom] of TInputSlider;
    VCin          :Array[1..MaxCom] of Longint;
    A,Value       :Longint;

{************************* DISPLAY WINDOW CONTENT ***************************}

Procedure REDRAW_FRAME;                 {*Define Window Content*}
Var A:Integer;
Begin
Win_Clip(On,W1);                        {*Clipping Window*}

TitleBox(LaF*4,  HaF*2, LaF*100, HaF*6,  7,'SCROLLTEXT MESSAGE',$0046);
TitleBox(LaF*4,  HaF*7, LaF*100, HaF*20, 7,'SCROLLTEXT PARAMETERS',$0046);
Display (LaF*16, HaF*08,-1,0,'VERTICAL POSITION');
Display (LaF*16, HaF*10,-1,0,'FONT SIZE');
Display (LaF*16, HaF*12,-1,0,'SINUS AMPLITUDE');
Display (LaF*16, HaF*14,-1,0,'TEXT ROTATION (CURVE)');
Display (LaF*16, HaF*16,-1,0,'ONDULATION SPEED');
Display (LaF*16, HaF*18,-1,0,'ONDULATION DISTORTION');

InputText(LaF*6, HaF*3+3, LaF*92, 255,12,11,0,$0026,Com1,Com1.Cin);
For A:=1 to MaxCom do InputSlider(LaF*6, 2*HaF*(A-1)+HaF*8, LaF*6,12,11,1,TMin[A],TMax[A],1,VCin[A],$0000,TIS[A]);

Button (LaF*28, HaF*22-4, LaF*16,-1, 0,7, $0110,But1,'_SAVE');
Button (LaF*58, HaF*22-4, LaF*16,-1, 0,7, $0000,But2,Loc(13));
Button (LaF*50, HaF*8,    LaF*48,-1, 11,9,$00,But3,'_TEST BLANKER');

Win_Clip(Off,W1);                       {*Restore Normal Clipping*}
End;

{****************************** MISCELLANEOUS *******************************}

Procedure VALIDATE_PARAM;
Var Code:Word;
Begin
ScrText:=Com1.Cin;                      {*Set Variables*}
Sofs:=  VCin[1];
Size:=  VCin[2];
Samp:=  VCin[3];
Curve:= VCin[4];
ScrSpd:=VCin[5];
Shrunk:=VCin[6];
If ScrSpd=0 Then ScrSpd:=1;             {*0 Interdit !*}
End;

{***************************** MAIN PROCEDURE *******************************}

Begin
Win_Init(Px,Py,Px+LaF*104,Py+HaF1+HaF*23+6,$51F9,'SCROLLTEXT PARAMETERS',W1);
Win_Sup(100,50,250,200,79,60,639,479,0,5,$0A10,W1);{*Supplement*}

If NError<>0 Then Exit;                 {*Initialisations Errors ?*}
Win_Draw(W1);                           {*Display Window*}

Com1.Cin:=ScrText;                      {*Init Variables*}
VCin[1]:=Sofs;
VCin[2]:=Size;
VCin[3]:=Samp;
VCin[4]:=Curve;
VCin[5]:=ScrSpd;
VCin[6]:=Shrunk;

REDRAW_FRAME;                           {*Display Window Content*}
XOk:=No; XCancel:=No;                   {*Init Exit Flags*}

Repeat;
If Win_Ready(W1) Then                   {*Test if Window Ready*}
   Begin                                {*Test Personnals Gadgets*}
   Win_Clip(On,W1);                     {*Clipping Window*}
   If Button_GetMsg(But1,1) Then XOk:=TRUE;
   If Button_GetMsg(But2,1) Then XCancel:=TRUE;
   If Button_GetMsg(But3,1) Then
      Begin
      VALIDATE_PARAM;
      Win_Clip(Off,W1);                 {*Restore Normal Clipping*}
      Save_Screen($013F);
      Blk_Anim;                         {*Lance Blanker*}
      Restore_Screen;
      Win_Clip(On,W1);                  {*Clipping Window*}
      End;
   InputText_GetMsg(Com1,Com1.Cin);
   For A:=1 to MaxCom do InputSlider_GetMsg(TIS[A],VCin[A]);
   Win_Clip(Off,W1);                    {*Restore Normal Clipping*}
   End;

Even:=Win_Test(W1);                     {*Get Windows Evens*}
If Even=1 Then XCancel:=Yes;            {*Window Closed   => Exit*}
If Even=9 Then REDRAW_FRAME;            {*Window Moved    => Display Content*}
Until (XOk) Or (XCancel);               {*Exit Flags*}

Win_Kill(W1);                           {*Close Window if Needs*}

If XOk Then Begin                       {*Save Parameters*}
   VALIDATE_PARAM;
   SAVE_PARAM;
   End;
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                        MAIN PROGRAM (INITIALISATIONS)                     Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Begin
INIT_BASE;                              {*Initialise Hardware*}
INIT_SCREEN;                            {*Initialise Screen*}
INIT_MOUSE;                             {*Initialise Mouse*}

Oldexit:=ExitProc;                      {*Intercept Errors*}
SetJump(MyAddr);
ExitProc:=@ENTRY_INT24;
BSET(Id_Scr1,7);                        {*Screen Blanker Activated*}
INIT_PARAM;                             {*Init Variables*}
LOAD_PARAM;                             {*Load from File...*}

Par:='-MOD';                            {*Run Blanker or Parameter ?*}
If (ParameterMOS(Par)>0) Then
   Begin
   If Par='PAR' Then Blk_Parameter(50,50);
   If Par='EXE' Then
      Begin
      Mse_Hide;
      Save_Screen($FFFF);
      Blk_Anim;
      Restore_Screen;
      End;
   End;
main_task;
DONE_MOUSE;                             {*Restore Mouse*}
DONE_SCREEN;                            {*Restore Screen*}
DONE_BASE;                              {*Restore Hardware*}
End.
