Subj : Re: MPL
To   : IGNATIUS
From : GRYPHON
Date : Thu Jan 31 2019 07:20 pm

On 09/15/14, ignatius said the following...
 
 ig>  Gr> I'll take a look at it.  What exactly is wrong with it?
 ig>  Gr> 
 ig> 
 ig> It doesn't execute. :/

I reworked it some. I noticed that there are no colord mci codes, where there
obviously should be some.  I'm thinking that they may have gotten stripped off
since it was posted to the message area here.

--------------------------------
Uses CFG;
Uses USER;

Var
  f           : file;
  Line1       : String;
  Line2       : String;
  Line3       : String;
  Line4       : String;
  Line5       : String;
  Line6       : String;
  Line7       : String;
  Line8       : String;
  automessage : String;
  Topic       : String;
  Date        : String;
  InStr       : String;
  Done        : Boolean;
  c1 : String; // Variables for the ColorScheme stuff: Colorscheme code thanks 
o Zoob
  c2 : String; // "          "          "        "
  c3 : String; // "          "          "        "
  p1 : String; // Variables for the DataField in the Menu Editor:
  p2 : String; //     i.e. "Menu" and "<color>"


//###########################
//##  Display Automesage  ###
//###########################

Procedure Write_Automsg
Begin
        GetThisUser
        If InputYN ('|CRsave this message? ') then // Said after Should_We has 
un
                begin
                fassign (f, automessage, 66) // Opens automessage.DAT
                freset (f)
                fWriteLn (f, 'from : '+ UserAlias) // Writes the useralias to f
le
                fWriteLn (f, 'topic: '+ Topic)     // Writes topic to file
                fWriteLn (f, 'date : '+ Date)      // Writes date to file
                fWriteLn (f, '|CR')
                If Line1 <> '' then FWriteLn (f, ' '+ Line1) // Displays 1st li
e
                If Line2 <> '' then FWriteLn (f, ' '+ Line2) // Displays 2nd li
e
                If Line3 <> '' then FWriteLn (f, ' '+ Line3) // and 3rd
                If Line4 <> '' then FWriteLn (f, ' '+ Line4) // what the hay, 4
h too
                If Line5 <> '' then FWriteLn (f, ' '+ Line5) // you guessed it,
5th
                If Line6 <> '' then FWriteLn (f, ' '+ Line6) // writes 8th line
                If Line7 <> '' then FWriteLn (f, ' '+ Line7) // writes 7th line
                If Line8 <> '' then FWriteLn (f, ' '+ Line8) // writes 6th line
                fClose (f)                         // Closes automessage.DAT
        End
        Done := False // Is menu finished or not? <false = not>
end

//##########################
//##  Write automessage  ###
//##########################

Procedure Should_We
begin
// boy, that question was long, I write here for it. Would you like to write au
message, question.
If InputNY ('|CRchange automsg? ') then
  begin
     Write ('|CRtopic: ')
     Topic := Input (60, 60, 1, '')
  end

// If Topic doesn't exist, write a new one

/*

  If FileExist(Topic)
      fOpen(1, Text, ReWrite, Topic)
     fClose(1) // Close Topic file
  End If

*/

// Writing automessage now

     WriteLn ('|CRenter automsg now.. 8 lines max|CR')
     Write (': ')  Line1 := Input (77, 77, 1, '')
        If Line1 = '' then // If nothing entered on line1, abort
        begin  Write_Automsg
         WriteLn('aborted!')
         Halt
        End
     Write (': ')  Line2 := Input (77, 77, 1, '')
        If Line2 = '' then // If nothing entered on line2, save automessage?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line3 := Input (77, 77, 1, '')
        If Line3 = '' then // If nothing entered on line3, save automessage?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line4 := Input (77, 77, 1, '')
        If Line4 = '' then // If nothing entered on line4, save automessage?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line5 := Input (77, 77, 1, '')
        If Line5 = '' then // Get the idea?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line6 := Input (77, 77, 1, '')
        If Line6 = '' then // I'm done typing here
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line7 := Input (77, 77, 1, '')
       If Line7 = '' then
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line8 := Input (77, 77, 1, '')
     Write_Automsg
     DispFile (automessage)
End


//#########################
//##  automessage Menu  ###
//#########################

Procedure Make_Menu
begin
Repeat // Repeat this stuff until Done := True(until user presses "Q")
   WriteLn ('                lQ-automessage v2.2')
   WriteLn ('')
   WriteLn ('{V} View automessage')
   WriteLn ('{W} Write automessage')
   WriteLn ('(R) Reply to Author of automessage')
   WriteLn ('')
   Write ('lQ-automessage [Q/Quit] ['+ StrRep(' ', 2)+ ')'+ StrRep(Chr(8), 3))

        InStr := Input(2, 2, 12, '') // The Input area is 2 characters long
        If InStr = 'V' Then         // If user presses "V" then it displays the
automesage
                DispFile (automessage)    // Display file "automessage.DAT"
        Else 
                If InStr = 'W' Then     // If "W" then Write the automessage
                        Should_We                 // Run Should_We procedure
                Else 
                        If InStr = 'R' Then           // If "R" then reply to A
thor of automessage
                                MenuCmd('MW', UserAlias) // Write to the author
of automessage
                        Else 
                                If InStr = 'Q' Then    // Quiting the menu
                                        Done := True             // Finally!
Until Done
End

//###########################
//##  Color Scheme Codes  ###
//###########################

Procedure Color_Me_Blind
begin
If p1='BLUE' then                            // If 1st word in menu data entry
    begin
    c1 :=''    c2 :=''  c3 :='' // equals BLUE then display those colors
    end
  Else If p1='GREEN' then                // Same as above, but for GREEN
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='CYAN'then                       // Same as above.
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='RED' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='MAGENTA' then
   begin
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='YELLOW' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='GREY' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p2='BLUE' then                  // Changed to if 2nd word in menudata
ield
   begin
    c1 :='';    c2 :='';  c3 :='' // equals BLUE then display these codes
   end
  Else If p2='GREEN' then // Same as p2='BLUE'
  begin
    c1 :='';   c2 :='';  c3 :='';
  end
  Else If p2='CYAN' then                 // Same as the other p2="<Color>"'s
    begin
    c1 :='';    c2 :='';  c3 :='';
    end
  Else If p2='RED' then
   begin
    c1 :=''    c2 :=''  c3 :=''
   end
  Else If p2='MAGENTA' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p2='YELLOW' then
    begin
    c1 :=''    c2 :=''  c3 :=''
     end
  Else If p2='GREY' then
   begin
    c1 :=''    c2 :=''  c3 :=''
   end
   Else                                  // If no color entered then use these
    c1 :=''    c2 :=''  c3 :='' // Color Codes
End


Begin
        automessage := CfgDataPath + 'automsg.dat'

        p1 := Upper(ParamStr(1)) // What the variables mean... This tells Mysti
 to
        p2 := Upper(ParamStr(2)) // look n the menu data field for the 1st & 2n
 word


        If p1='MENU'then      // If 1st word in menudatafield equals this then 
isplay
                 Make_Menu         // the menu
        Else 
                If p2='MENU' then  // If the 2nd word in menudatafield equals t
is then dsplays
                         Make_Menu      // the menu. Just so you can have these
things in any order(the menu and color)

/*
        If FileExist(Date) Then Begin
                fOpen(1, Text, ReWrite, Date);
                fClose(1);
        End
*/

        Date := DateStr(DateTime, 1) // Date equals this
        Color_Me_Blind                 // Run this procedure(the color scheme)
        DispFile(automessage)          // Run this procedure(display automessag
)
        Should_We                      // Run this procedure(change automessage
)
End
------------------------------

 "No matter where you go, there you are!" - B. Bonzai

--- Mystic BBS v1.10 A51 (Linux)
 * Origin: Cyberia BBS | Cyberia.Darktech.Org | Kingwood, TX (46:1/116)
 þ Synchronet þ thePharcyde_ >> telnet://bbs.pharcyde.org (Wisconsin)

.