home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB5.ZIP / MAKAMOVI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-09-15  |  25.9 KB  |  833 lines
  1. { (c) 1984 by Neil J. Rubenking }
  2. program MakeAMovie;
  3. type
  4.   ScreenLoc = record
  5.                 character : char;
  6.                 attribute : byte;
  7.               end;
  8.   DefinedLoc  = record
  9.                 data : ScreenLoc;
  10.                 c,r  : byte;
  11.               end;
  12.   OneLine   = array[1..80] of ScreenLoc;
  13.   Screen    = array[1..25] of OneLine;
  14.   ScreenSet = ^node;
  15.   node      = record
  16.                 AScreen : Screen;
  17.                 next    : ScreenSet;
  18.               end;
  19.   DiffFil  = file of DefinedLoc;
  20.   FileNameType = string[14];
  21. var
  22.   ScreenSeg, wait          : integer;
  23.   ScreenItself             : Screen absolute $B000:$0000;
  24.   ColorScreen              : Screen absolute $B800:$0000;
  25.   TempScreen, MenuScreen,
  26.   LastScreen               : Screen;
  27.   Screens, Pointer, temp,
  28.   EndPointer               : ScreenSet;
  29.   ScreenNum                : byte;
  30.   col, row, N, P           : byte;
  31.   DiffFile                 : DiffFil;
  32.   filename                 : FileNameType;
  33.   exists, color, First,OK  : boolean;
  34.   choice, EscChoice        : char;
  35.   BlankLine,  HighLine     : OneLine;
  36.   EndLoc                   : DefinedLoc;
  37. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  38. procedure twitter(note:integer);
  39. var
  40.   N : byte;
  41. begin
  42.   for N := 1 to 10 do
  43.     begin
  44.       sound(note);
  45.       delay(50);
  46.       sound(note*2);
  47.       delay(50);
  48.     end;
  49.   nosound;
  50. end;
  51. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  52. procedure GetKeys(var C, D:char);
  53. begin
  54.   D := chr(0);
  55.   repeat until keypressed;
  56.   read(Kbd,C);
  57.   if keypressed then read(Kbd,D);
  58. end;
  59. {============================================================================}
  60. function ReadScreen(col,row:byte):char;
  61. var
  62.   LocationCode : integer;
  63.   begin
  64.     LocationCode := (col-1)*2 + (row-1)*160;
  65.     ReadScreen   := chr(Mem[ScreenSeg:LocationCode]);
  66.   end;
  67. {============================================================================}
  68. procedure WriteScrn(col, row: byte; thisChar:char);
  69. var
  70.   LocationCode : integer;
  71. begin
  72.   LocationCode := (col-1)*2 + (row-1)*160;
  73.   Mem[ScreenSeg:locationCode] := ord(ThisChar);
  74. end;
  75. {============================================================================}
  76. procedure ScreenAttribute(col, row, attribute: byte);
  77. var
  78.   LocationCode : integer;
  79. begin
  80.   LocationCode := (col-1)*2+1 + (row-1)*160;
  81.   Mem[ScreenSeg:locationCode] := attribute;
  82. end;
  83. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  84. procedure MakeScreen; forward;
  85. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  86. procedure ReverseOn;
  87. begin
  88.   TextColor(lightBlue);
  89.   TextBackground(white);
  90. end;
  91. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  92. procedure ReverseOff;
  93. begin
  94.   TextColor(white);
  95.   TextBackground(black);
  96. end;
  97. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  98. procedure AttemptReset(var ThisFile : DiffFil);
  99. begin
  100.   {$I-}
  101.   reset(ThisFile);
  102.   {$I+}
  103. end;
  104. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  105. function different(var C,D:screenLoc):boolean;
  106. begin
  107.   different := (C.character <> D.character) or
  108.                (C.attribute <> D.attribute);
  109. end;
  110. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  111. procedure ShowLocation;
  112. var
  113.   SaveX,SaveY : byte;
  114. begin
  115.   WriteScrn(54,1,chr((WhereX div 10)+48));
  116.   WriteScrn(55,1,chr((WhereX mod 10)+48));
  117.   WriteScrn(61,1,chr((WhereY div 10)+48));
  118.   WriteScrn(62,1,chr((WhereY mod 10)+48));
  119. end;
  120. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  121. procedure DisposeAll(var List:ScreenSet);
  122. begin
  123.   if List <> nil then
  124.     begin
  125.       DisposeAll(list^.next);
  126.       Dispose(list);
  127.     end;
  128.   List := nil;
  129. end;
  130. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  131. procedure EditAScreen(operation : char);
  132. var
  133.   last : boolean;
  134.   TheWord : string[12];
  135.   count   : byte;
  136.   {========================================================================}
  137.    procedure ShowIt;
  138.      begin
  139.        ScreenItself := Pointer^.AScreen;
  140.        ColorScreen  := Pointer^.AScreen;
  141.        ScreenItself[1] := HighLine;
  142.        ColorScreen[1]  := HighLine;
  143.        GotoXY(1,1);
  144.        ReverseOn;
  145.        Write('Press ',chr(26),' to page thru , <return> to select,');
  146.        Write(' <Esc> to exit.      Screen # ',count);
  147.        ReverseOff;
  148.      end;
  149.   {========================================================================}
  150. begin
  151.   case operation of
  152.     'e': TheWord := 'edit';
  153.     'r': TheWord := 'remove';
  154.     'i': TheWord := 'insert';
  155.   end;
  156.   ClrScr;
  157.   GotoXY(10,18);
  158.   Write('Page through the screens by pressing the right arrow key.');
  159.   GotoXY(10,19);
  160.   Write('When you get to the one');
  161.   if operation = 'i' then write(' after which');
  162.   Write(' you want to ',TheWord,' press <return>.');
  163.   GotoXY(10,20);
  164.   Write('To quit without ',Theword,'ing, press <Esc> or page past the end.');
  165.   GotoXY(10,21);
  166.   Write('Now press a key . . .');
  167.   repeat until keypressed;
  168.   Pointer := Screens;
  169.   last    := False;
  170.   ShowIt;
  171.   count := 1;
  172.   repeat
  173.     GetKeys(choice,EscChoice);
  174.       if (choice = chr(27)) and (EscChoice = 'M') then
  175.         begin
  176.           Pointer := Pointer^.next;
  177.           count := count + 1;
  178.           if Pointer <> nil then ShowIt else
  179.             begin
  180.               last := true;
  181.               count := 0;
  182.             end;
  183.         end;
  184.       if (choice = chr(13)) and (not last) then
  185.         begin
  186.           case operation of
  187.             'e': begin
  188.                    MakeScreen;
  189.                    tempScreen[1] := BlankLine;
  190.                    Pointer^.AScreen := tempScreen;
  191.                    last := true;
  192.                  end;
  193.             'r': begin
  194.                    if Pointer^.next = nil then Pointer := nil
  195.                    else
  196.                      begin
  197.                        Pointer^.AScreen := Pointer^.next^.AScreen;
  198.                        Pointer^.next    := Pointer^.next^.next;
  199.                      end;
  200.                    last := true;
  201.                    ScreenNum := ScreenNum - 1;
  202.                  end;
  203.             'i': begin
  204.                    MakeScreen;
  205.                    TempScreen[1] := BlankLine;
  206.                    new(temp);
  207.                    temp^.AScreen := tempScreen;
  208.                    temp^.next := Pointer^.next;
  209.                    Pointer^.next := temp;
  210.                    last := true;
  211.                    ScreenNum := ScreenNum + 1;
  212.                    count := count + 1;
  213.                  end;
  214.           end;  {case}
  215.         end;   {if <return> pressed}
  216.   until ((choice = chr(27)) and (EscChoice = chr(0))) or last;
  217.   if count > 0 then
  218.     begin
  219.       ScreenItself[1] := HighLine;
  220.       ColorScreen [1] := HighLine;
  221.       GotoXY(1,1);
  222.       Write('Screen #',count,' has been ',Theword,'ed.');
  223.       twitter(500);twitter(1000);
  224.     end;
  225.   ScreenItself := MenuScreen;
  226.   ColorScreen  := MenuScreen;
  227. end;
  228. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  229. procedure SaveAllScreens;
  230. var
  231.   LastScreen : Screen;
  232.   tempo      : DefinedLoc;
  233.   {===============================================}
  234.   procedure DiffWrite(var A,B:screen);
  235.   begin
  236.     for row := 1 to 25 do
  237.       begin
  238.         for col := 1 to 80 do
  239.           begin
  240.             if different(A[row][col],B[row][col]) then
  241.               begin
  242.                 with tempo do
  243.                   begin
  244.                     data := A[row][col];
  245.                     r    := row;
  246.                     c    := col;
  247.                   end;
  248.                 write(DiffFile,tempo);
  249.               end;
  250.           end;
  251.       end;
  252.     write(DiffFile,EndLoc);
  253.   end;
  254.   {===============================================}
  255.   procedure DoWrite(var list:ScreenSet);
  256.   begin
  257.     while list <> nil do
  258.       begin
  259.         DiffWrite(list^.AScreen, LastScreen);
  260.         LastScreen := list^.AScreen;
  261.         list := list^.next;
  262.       end;
  263.   end;
  264.   {===============================================}
  265.   begin
  266.     for row := 1 to 25 do
  267.       for col := 1 to 80 do
  268.         with LastScreen[row][col] do
  269.           begin
  270.             character := ' ';
  271.             attribute := 15;
  272.           end;
  273.     ClrScr;
  274.     GotoXY(20,20);
  275.     Write('Name of Screen file? (omit extension!) ');
  276.     read(fileName);
  277.     P := pos('.',filename);
  278.     if P <> 0 then delete(filename,P,length(filename)-P+1);
  279.     filename := filename + '.scn';
  280.     Assign(DiffFile,filename);
  281.     WriteLn;
  282.     exists := false;
  283.     AttemptReset(DiffFile);
  284.     exists := (IOResult = 0);
  285.     if exists then
  286.       begin
  287.         choice := 'N';
  288.         Write(filename,' already exists.  OverWrite? ');
  289.         read(choice);
  290.       end;
  291.     if (not exists) or (UpCase(choice) = 'Y') then
  292.       begin
  293.         ReWrite(DiffFile);
  294.         Pointer := Screens;
  295.         DoWrite(Pointer);
  296.       end;
  297.     close(DiffFile);
  298.   end;
  299. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  300. procedure AddScreen(ScreenToAdd:Screen);
  301. begin
  302.   ScreentoAdd[1] := BlankLine;
  303.   if First then
  304.     begin
  305.       new(Screens);
  306.       Screens^.AScreen := ScreenToAdd;
  307.       Screens^.next    := nil;
  308.       EndPointer       := Screens;
  309.       ScreenNum        := 1;
  310.       First            := false;
  311.     end
  312.   else
  313.     begin
  314.       new(EndPointer^.next);
  315.       EndPointer := EndPointer^.next;
  316.       EndPointer^.AScreen := ScreenToAdd;
  317.       EndPointer^.next    := nil;
  318.       ScreenNum     := ScreenNum + 1;
  319.     end;
  320. end;
  321. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  322. procedure ReadScreenFile(TheName:FileNameType);
  323. var
  324.   diff : DefinedLoc;
  325. begin
  326.   for row := 1 to 25 do
  327.     for col := 1 to 80 do
  328.       with LastScreen[row][col] do
  329.         begin
  330.           character := ' ';
  331.           attribute := 15;
  332.         end;
  333.   Assign(DiffFile,TheName);
  334.   WriteLn;
  335.   AttemptReset(DiffFile);
  336.   if (IOResult = 0) and (FileSize(DiffFile) > 0) then
  337.     begin
  338.       ScreenNum := 0;
  339.       First     := true;
  340.       DisposeAll(Screens);
  341.       While not EOF(DiffFile) do
  342.         begin
  343.           read(DiffFile,diff);
  344.           if different(diff.data,EndLoc.data) then
  345.             LastScreen[diff.r][diff.c] := diff.data
  346.           else
  347.             AddScreen(LastScreen);
  348.         end;  {while}
  349.     end   {if}
  350.   else
  351.     OK := false;
  352.   close(DiffFile);
  353. end;
  354. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  355. procedure GetReadyScreenFile;
  356.   begin
  357.     ClrScr;
  358.     GotoXY(20,20);
  359.     Write('Name of Screen file? (omit extension!) ');
  360.     read(fileName);
  361.     WriteLn;
  362.     P := pos('.',filename);
  363.     if P <> 0 then delete(filename,P,length(filename)-P+1);
  364.     filename := filename + '.scn';
  365.     OK := true;
  366.     ReadScreenFile(filename);
  367.     if not OK then write('Not found.');
  368. end;
  369. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  370. procedure MakeScreen;
  371. var
  372.   choice1, EscChoice : char;
  373.   SaveX, SaveY       : byte;
  374.   {================================================}
  375.    procedure GoUp;
  376.      begin
  377.        if WhereY > 2 then GotoXY(WhereX,WhereY-1);
  378.      end;
  379.   {================================================}
  380.    procedure GoDown;
  381.      begin
  382.        if WhereY < 25 then GotoXY(WhereX,WhereY+1);
  383.      end;
  384.   {================================================}
  385.    procedure GoLeft;
  386.      begin
  387.        if WhereX > 1 then GotoXY(WhereX-1,WhereY);
  388.      end;
  389.   {================================================}
  390.    procedure GoRight;
  391.      begin
  392.        if WhereX < 80 then GotoXY(WhereX+1,WhereY);
  393.      end;
  394.   {================================================}
  395.    procedure LineDraw;
  396.    var
  397.      LastDir, ThisDir  : char;
  398.      choice1,EscChoice : char;
  399.      nups,ndowns,nlefts,nrights,allchars : set of char;
  400.      ups,downs,lefts,rights : set of char;
  401.      draw  : boolean;
  402.      {----------------------------------------------------}
  403.      function RightChar(ThisDir,LastDir:char):char;
  404.      var
  405.        temp : char;
  406.        {- - - - - - - - - - - - - - - - - - - - - - - - -}
  407.         function combine(A,B:char):char;
  408.         var
  409.           tempset : set of char;
  410.           temp, C    : char;
  411.         begin
  412.           if A = B then temp := A
  413.             else if A = ' ' then temp := B
  414.             else
  415.               begin
  416.                 tempset := allchars;
  417.                 if (A in ups) or (B in ups) then
  418.                   tempset := tempset - nups;
  419.                 if (A in Nups) and (B in Nups) then
  420.                   tempset := tempset - ups;
  421.                 if (A in downs) or (B in downs) then
  422.                   tempset := tempset - ndowns;
  423.                 if (A in Ndowns) and (B in Ndowns) then
  424.                   tempset := tempset - downs;
  425.                 if (A in lefts) or (B in lefts) then
  426.                   tempset := tempset - nlefts;
  427.                 if (A in Nlefts) and (B in Nlefts) then
  428.                   tempset := tempset - lefts;
  429.                 if (A in rights) or (B in rights) then
  430.                   tempset := tempset - nrights;
  431.                 if (A in Nrights) and (B in Nrights) then
  432.                   tempset := tempset - rights;
  433.                 for C := '╣' to '╬' do if C in tempset then temp := C;
  434.               end;
  435.           combine := temp;
  436.         end;
  437.        {- - - - - - - - - - - - - - - - - - - - - - - - -}
  438.      begin
  439.        case LastDir of
  440.          'H': case ThisDir of
  441.                 'H': temp := '║';
  442.                 'K': temp := '╗';
  443.                 'M': temp := '╔';
  444.                 'P': temp := ' ';
  445.               end;
  446.          'K': case ThisDir of
  447.                 'H': temp := '╚';
  448.                 'K': temp := '═';
  449.                 'M': temp := ' ';
  450.                 'P': temp := '╔';
  451.               end;
  452.          'M': case ThisDir of
  453.                 'H': temp := '╝';
  454.                 'K': temp := ' ';
  455.                 'M': temp := '═';
  456.                 'P': temp := '╗';
  457.               end;
  458.          'P': case ThisDir of
  459.                 'H': temp := ' ';
  460.                 'K': temp := '╝';
  461.                 'M': temp := '╚';
  462.                 'P': temp := '║';
  463.               end;
  464.        end;   {case}
  465.        if ReadScreen(WhereX,WhereY) in AllChars then
  466.          RightChar := Combine(temp,ReadScreen(WhereX,WhereY))
  467.        else RightChar := temp;
  468.     end;
  469.      {----------------------------------------------------}
  470.    begin
  471.      AllChars := ['╣','║','╗','╝','╚','╔','╩','╦','╠','═','╬'];
  472.      nups    := ['╗','╔','╦','═'];
  473.      ndowns  := ['╝','╚','╩','═'];
  474.      nlefts  := ['║','╚','╔','╠'];
  475.      nrights := ['╣','║','╗','╝'];
  476.      ups     := AllChars - nups;
  477.      downs   := AllChars - ndowns;
  478.      rights  := AllChars - nrights;
  479.      lefts   := Allchars - nlefts;
  480.      draw    := false;
  481.      ReverseOn;
  482.      SaveX := WhereX; SaveY := WhereY;
  483.      GotoXY(1,1);
  484.      Write('[Esc] = back to plain draw   F2 toggles line     col    row');
  485.      GotoXY(SaveX,SaveY);
  486.      ReverseOff;
  487.      ShowLocation;
  488.      LastDir := '<';
  489.      repeat
  490.        GetKeys(choice1,EscChoice);
  491.        if EscChoice in ['H','K','M','P','<','ä','s','t','u','v','w'] then
  492.          begin
  493.            if EscChoice = '<' then draw := not(draw);
  494.            if draw then WriteScrn(WhereX,WhereY,RightChar(EscChoice,LastDir));
  495.            LastDir := EscChoice;
  496.            case EscChoice of
  497.              'H': GoUp;     'ä': if not draw then GotoXY(WhereX,2);
  498.              'K': GoLeft;   's': if not draw then GotoXY(1,WhereY);
  499.              'M': GoRight;  't': if not draw then GotoXY(80,WhereY);
  500.              'P': GoDown;   'v': if not draw then GotoXY(WhereX,25);
  501.                             'w': if not draw then GotoXY(1,2);
  502.                             'u': if not draw then GotoXY(80,25);
  503.            end;
  504.            ShowLocation;
  505.          end;
  506.      until (choice1 = chr(27)) and (EscChoice = chr(0));
  507.      ReverseOn;
  508.      SaveX := WhereX;
  509.      SaveY := WhereY;
  510.      GotoXY(1,1);
  511.      Write('F1 = block draw  F2 line draw                    col    row');
  512.      ReverseOff;
  513.      GotoXY(SaveX,SaveY);
  514.    end;
  515.   {================================================}
  516.    procedure BlockDraw;
  517.    var
  518.      choice1,EscChoice : char;
  519.      N,M : byte;
  520.    {------------------------------------------------------------}
  521.     procedure TEN(C:char);
  522.     begin
  523.       M := 80 - WhereX;
  524.       if M > 10 then M := 10;
  525.       if M > 0 then
  526.         for N := 1 to M do write(C);
  527.     end;
  528.    {------------------------------------------------------------}
  529.     procedure FIVE(C:char);
  530.     begin
  531.       M := 25 - WhereY;
  532.       if M > 5 then M := 5;
  533.       if M > 0 then for N := WhereY to WhereY + M do
  534.         begin
  535.           GotoXY(WhereX, N);
  536.           write(C);write(chr(8));
  537.         end;
  538.     end;
  539.    {------------------------------------------------------------}
  540.    begin
  541.      ColorScreen[1]  := HighLine;
  542.      ScreenItself[1] := HighLine;
  543.      ReverseOn;
  544.      SaveX := WhereX;
  545.      SaveY := WhereY;
  546.      GotoXY(1,1);
  547.      Write('F1░ F2▒ F3▓ F4█ F5▄ F6▀ F7▌ F8▐ F9■ F10{space}   col    row');
  548.      ReverseOff;
  549.      GotoXY(SaveX,SaveY);
  550.      ShowLocation;
  551.      repeat
  552.        GetKeys(choice1,EscChoice);
  553.        Case EscChoice of
  554.          'G': begin GoUp;GoLeft;end;    ';': write('░'); 'T': TEN('░');
  555.          'H': GoUp;                     '<': write('▒'); 'U': TEN('▒');
  556.          'I': begin GoUp;GoRight;end;   '=': write('▓'); 'V': TEN('▓');
  557.          'K': GoLeft;                   '>': write('█'); 'W': TEN('█');
  558.          'M': GoRight;                  '?': write('▄'); 'X': TEN('▄');
  559.          'O': begin GoDown;GoLeft;end;  '@': write('▀'); 'Y': TEN('▀');
  560.          'P': GoDown;                   'A': write('▌'); 'Z': TEN('▌');
  561.          'Q': begin;GoDown;GoRight;end; 'B': write('▐'); '[': TEN('▐');
  562.          'ä': GotoXY(WhereX,2);         'C': write('■'); '/': TEN('■');
  563.          's': GotoXY(1,WhereY);         'D': write(' '); ']': TEN(' ');
  564.          't': GotoXY(80,WhereY);        'h': FIVE('░');  'm': FIVE('▀');
  565.          'v': GotoXY(WhereX,25);        'i': FIVE('▒');  'n': FIVE('▌');
  566.          'w': GotoXY(1,2);              'j': FIVE('▓');  'o': FIVE('▐');
  567.          'u': GotoXY(80,25);            'k': FIVE('█');  'p': FIVE('■');
  568.                                         'l': FIVE('▄');  'q': FIVE(' ');
  569.        end;  {case}
  570.        ShowLocation;
  571.      until (choice1 = chr(27)) and (EscChoice = chr(0));
  572.      ColorScreen[1]  := HighLine;
  573.      ScreenItself[1] := HighLine;
  574.      ReverseOn;
  575.      SaveX := WhereX; SaveY := WhereY;
  576.      GotoXY(1,1);
  577.      Write('F1 = block draw  F2 line draw                    col    row');
  578.      ReverseOff;
  579.      GotoXY(SaveX,SaveY);
  580.    end;
  581.   {================================================}
  582. begin
  583.   ColorScreen[1]  := HighLine;
  584.   ScreenItself[1] := HighLine;
  585.   ReverseOn;
  586.   GotoXY(1,1);
  587.   Write('F1 = block draw  F2 line draw                    col    row');
  588.   ReverseOff;
  589.   GotoXY(40,20);
  590.   ShowLocation;
  591.   repeat
  592.     GetKeys(choice1,EscChoice);
  593.     Case EscChoice of
  594.       'G': begin GoUp;GoLeft;end;     'w': GotoXY(1,2);
  595.       'H': GoUp;
  596.       'I': begin GoUp;GoRight;end;    'ä': GotoXY(WhereX,2);
  597.       'K': GoLeft;                    's': GotoXY(1,WhereY);
  598.       'M': GoRight;                   't': GotoXY(80,WhereY);
  599.       'O': begin GoDown;GoLeft;end;   'u': GotoXY(80,25);
  600.       'P': GoDown;
  601.       'Q': begin;GoDown;GoRight;end;  'v': GotoXY(WhereX,25);
  602.       ';': BlockDraw;
  603.       '<': LineDraw;
  604.       'C': begin; WriteScrn(WhereX,WhereY,chr(27)); GoRight; end;
  605.       'D': begin; WriteScrn(WhereX,WhereY,chr(3)) ; GoRight; end;
  606.     else
  607.        case ord(choice1) of
  608.          3:;{chr(3) = ^C, so this will not come up}
  609.          8: begin; GoLeft; WriteScrn(WhereX,WhereY,' ');end;
  610.         27:;{chr(27) = Esc, so entering it will exit draw mode}
  611.        else
  612.          WriteScrn(WhereX,WhereY,choice1);
  613.          GoRight;
  614.        end;  {inner case}
  615.     end;  {case}
  616.     ShowLocation;
  617.   until (choice1 = chr(27)) and (EscChoice = chr(0));
  618.   if color then tempScreen := ColorScreen
  619.   else tempScreen := screenItself;
  620. end;
  621. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  622. procedure SeeScreen;
  623. var
  624.   Number, count : byte;
  625. begin
  626.   ClrScr;
  627.   GotoXY(20,20);
  628.   number := ScreenNum;
  629.   Write('There are ',ScreenNum,' screens.  Which #? ');
  630.   GotoXY(20,21);
  631.   write('(Just <enter> for latest screen)');
  632.   read(Number);
  633.   if (Number > 0) and (Number <= ScreenNum) then
  634.     begin
  635.       Pointer := Screens;
  636.       count := 1;
  637.       while count < Number do
  638.         begin
  639.           if Pointer^.next <> nil then Pointer := Pointer^.next;
  640.           count := count + 1;
  641.         end;
  642.       ScreenItself := Pointer^.AScreen;
  643.       ColorScreen  := Pointer^.AScreen;
  644.     end
  645.   else
  646.     begin
  647.       ScreenItself := TempScreen;
  648.       ColorScreen  := TempScreen;
  649.     end;
  650.   MakeScreen;
  651. end;
  652. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  653. procedure DoPlay(var list:ScreenSet;wait:integer);
  654. begin
  655.   ScreenItself := list^.AScreen;
  656.   ColorScreen  := list^.AScreen;
  657.   delay(wait);
  658.   list := list^.next
  659. end;
  660. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  661. procedure PlayScreens;
  662. begin
  663.   GotoXY(32,20);
  664.   Write('How much wait between? ');
  665.   read(wait);
  666.   Pointer := Screens;
  667.   GotoXY(1,1);
  668.   While Pointer <> nil do DoPlay(Pointer,wait);
  669.   ColorScreen[1]  := HighLine;
  670.   ScreenItself[1] := HighLine;
  671.   ReverseOn;
  672.   GotoXY(1,1);
  673.   write('Press a key to continue . . .');
  674.   repeat until keypressed;
  675.   ReverseOff;
  676. end;
  677. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  678. procedure CycleScreens;
  679. begin
  680.   GotoXY(32,22);
  681.   Write('How much wait between? ');
  682.   read(wait);
  683.   GotoXY(1,1);
  684.   repeat
  685.     Pointer := Screens;
  686.     While Pointer <> nil do DoPlay(Pointer,wait);
  687.   until keypressed;
  688. end;
  689. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  690. procedure FinishUp;
  691. var
  692.   choice : char;
  693. begin
  694.   if color then tempScreen := ColorScreen
  695.   else TempScreen := ScreenItself;
  696.   ClrScr;
  697.   GotoXY(20,20);
  698.   Write('Are you sure you want to quit? ');
  699.   GotoXY(20,21);
  700.   Write('If you didn`t save your work yet, just say "N".');
  701.   repeat until keypressed;
  702.   read(Kbd,choice);
  703.   if UpCase(choice) = 'Y' then halt
  704.     else
  705.       begin
  706.         ScreenItself := TempScreen;
  707.         ColorScreen  := TempScreen;
  708.       end;
  709. end;
  710. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  711. procedure MakeMenuScreen;
  712. var
  713.   MenuLines : array[1..11] of string[40];
  714. begin
  715.   MenuLines[1] :=  'F1  CREATE a screen                     ';
  716.   MenuLines[2] :=  'F2  ADD    a screen to the list         ';
  717.   MenuLines[3] :=  'F3  REMOVE a screen from the list       ';
  718.   MenuLines[4] :=  'F4  INSERT a screen into the list       ';
  719.   MenuLines[5] :=  'F5  EDIT   any screen in the list       ';
  720.   MenuLines[6] :=  'F6  RE-USE a screen                     ';
  721.   MenuLines[7] :=  'F7  WRITE  the list to a file           ';
  722.   MenuLines[8] :=  'F8  READ   a file into a new list       ';
  723.   MenuLines[9] :=  'F9  PLAY   the current list             ';
  724.   MenuLines[10] := 'F10 CYCLE  thru current screens         ';
  725.   MenuLines[11] := 'ESCAPE always gets you out!             ';
  726. for row := 1 to 25 do MenuScreen[row] := BlankLine;
  727. for row := 1 to 11 do
  728.   begin
  729.     for col := 21 to 60 do
  730.       begin
  731.         MenuScreen[2*row+2][col].character := MenuLines[row][col-20];
  732.         if (col in [21,22,25..30]) and (row < 11)
  733.         then MenuScreen[2*row+2][col].attribute := 112
  734.           else MenuScreen[2*row+2][col].attribute := 15;
  735.       end;
  736.   end;
  737.   MenuScreen[22][23].attribute := 112;
  738. end;
  739. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  740. procedure MainMenu;
  741. var
  742.   filler, choice : char;
  743. begin
  744.   ScreenItself := MenuScreen;
  745.   ColorScreen  := MenuScreen;
  746.   repeat
  747.     GetKeys(filler,choice);
  748.     if (filler = chr(27)) and (choice = chr(0)) then FinishUp;
  749.   until choice in [';','<','=','>','?','@','A','B','C','D'];
  750.   case choice of
  751.     ';': begin
  752.            ClrScr;
  753.            MakeScreen;
  754.          end;
  755.     '<': begin
  756.            AddScreen(tempScreen);
  757.            GotoXY(25,6);
  758.            Write('ADDed screen # ',ScreenNum,'.                  ');
  759.            twitter(500);
  760.          end;
  761.     '=': EditAScreen('r');
  762.     '>': EditAScreen('i');
  763.     '?': EditAScreen('e');
  764.     '@': SeeScreen;
  765.     'A': SaveAllScreens;
  766.     'B': GetReadyScreenFile;
  767.     'C': PlayScreens;
  768.     'D': CycleScreens;
  769.   end;
  770. end;
  771. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  772. procedure initialize;
  773. begin
  774.   First := true;
  775.   if (Mem[0000:1040] and 48) <> 48 then
  776.     begin
  777.       ScreenSeg := $B800;
  778.       color     := true;
  779.     end
  780.   else
  781.     begin
  782.       ScreenSeg := $B000;
  783.       color     := false;
  784.     end;
  785.   ScreenNum := 0;
  786.   Screens := nil;
  787.   for N := 1 to 80 do
  788.     begin
  789.       BlankLine[N].character := ' ';
  790.       BlankLine[N].attribute := 15;
  791.       HighLine[N].character := ' ';
  792.       HighLine[N].attribute := 9;
  793.     end;
  794.   MakeMenuScreen;
  795.   with EndLoc do
  796.     begin
  797.       data.character := chr(0);
  798.       data.attribute := 0;
  799.       r := 0; c := 0;
  800.     end;
  801.   filename := '';
  802. end;
  803. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  804. procedure IntroMovie;
  805. begin
  806.   OK := true;
  807.   filename := 'intro.scn';
  808.   ReadScreenFile(filename);
  809.   if OK then
  810.     begin
  811.       Twitter(500);Twitter(1000);Twitter(1500);
  812.       Pointer := Screens;
  813.       wait := 50;
  814.       While Pointer <> nil do DoPlay(Pointer,wait);
  815.       ColorScreen[1]  := HighLine;
  816.       ScreenItself[1] := HighLine;
  817.       ReverseOn;
  818.       GotoXY(1,1);
  819.       write('Press a key to continue . . .');
  820.       repeat until keypressed;
  821.       ReverseOff;
  822.       DisposeAll(Screens);
  823.       ScreenNum := 0;
  824.       First := true;
  825.     end;
  826.  end;
  827. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  828. begin
  829.   initialize;
  830.   IntroMovie;
  831.   repeat MainMenu until false;
  832.   ClrScr;
  833. end.