home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
editors
/
ae.arj
/
AE3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-08
|
24KB
|
589 lines
unit AE3 ;
{$B-}
{$I-}
{$S+}
{$V-}
interface
uses Crt,Dos,AE0,AE1,AE2 ;
procedure EnterString (var S:string; Prompt:string ; MaxLength:byte ;
CapsLock:boolean ; AlphaOnly:boolean) ;
procedure EnterWord (var W:word ; Prompt:string ; MinValue,MaxValue:word) ;
procedure EnterBoolean (var B:boolean ; Prompt:string ) ;
procedure SaveFile (Wsnr:byte) ;
function GetKeyNr : word ;
function Answer (question:string) : boolean ;
function Choose (Choices:string) : char ;
implementation
{-----------------------------------------------------------------------------}
{ Prompts the user to enter a string on the bottom line of the screen, with }
{ maximum length <MaxLength>. Parameters CapsLock and AlphaOnly instruct the }
{ procedure to convert lower case characters to upper case, and to accept }
{ only alphanumeric characters, respectively. Pressing Escape will restore }
{ the old value of S. }
{-----------------------------------------------------------------------------}
procedure EnterString (var S:string; Prompt:string ; MaxLength:byte ;
CapsLock:boolean ; AlphaOnly:boolean) ;
var OldS : string ;
OldXpos,OldYpos : byte ;
OldCursorType : byte ;
i : byte ;
Key : word ;
Start,VisibleLength : byte ;
begin
{ replace CR/LF pairs in string with CRLFalias }
repeat i := Pos (CR+LF,S) ;
if i > 0
then begin
S[i] := CRLFalias[1] ;
S[i+1] := CRLFalias[2] ;
end ;
until i = 0 ;
OldXpos := WhereX ;
OldYpos := WhereY ;
OldCursorType := GetCursor ;
SetCursor (Config.Setup.CursorType) ;
OldS := S ;
Start := 1 ;
VisibleLength := ColsOnScreen - Length(Prompt) - 1 ;
SetBottomLine (Prompt+Copy(S,Start,VisibleLength)) ;
CursorTo (Length(Prompt)+1,25) ;
Key := GetKeyNr ;
if (Key < 256) or (Key = CtrlReturnKey)
then S := '' ;
i := 1 ;
repeat case Key of
264 {Bksp} : if i > 1
then begin
if Copy(S,i-1,2) = CRLFalias
then begin
Dec (i,2) ;
Delete (S,i,2) ;
end
else begin
Dec (i) ;
Delete (S,i,1) ;
end ;
end
else WarningBeep ;
EscapeKey : S := OldS ;
32..126 : if Length(S) < MaxLength
then begin
if CapsLock
then Insert (UpCase(Chr(Key)),S,i)
else Insert (Chr(Key),S,i) ;
Inc (i) ;
end
else WarningBeep ;
1..31,
127..255 : if (not AlphaOnly) and (Length(S) < MaxLength)
then begin
Insert (Chr(Key),S,i) ;
Inc (i) ;
end
else WarningBeep ;
CtrlReturnKey : if (not AlphaOnly) and (Length(S) < (MaxLength-1))
then begin
Insert (CRLFalias,S,i) ;
Inc (i,2)
end
else WarningBeep ;
327 {Home} : i := 1 ;
335 {End} : i := Length (S) + 1 ;
331 {Left} : begin
if i > 1
then begin
if (Copy(S,i-2,2) = CRLFalias) and (i > 2)
then Dec (i,2)
else Dec (i) ;
end ;
end ;
333 {Right} : if i <= Length (S)
then begin
if Copy(S,i,2) = CRLFalias
then Inc (i,2)
else Inc (i) ;
end ;
339 {Del} : if Copy(S,i,2) = CRLFalias
then Delete (S,i,2)
else Delete (S,i,1) ;
end ; {of case}
if i > (Start+VisibleLength)
then Start := i - VisibleLength
else begin
if Start > i
then Start := i ;
end ;
SetBottomLine (Prompt+Copy(S,Start,VisibleLength)) ;
CursorTo (Length(Prompt)+1+i-Start,25) ;
if (Key <> ReturnKey) and (Key <> EscapeKey) then Key := GetKeyNr ;
until (Key = ReturnKey) or (Key = EscapeKey) ;
{ replace CRLFalias in string with CR/LF pairs }
repeat i := Pos (CRLFalias,S) ;
if i > 0
then begin
S[i] := CR ;
S[i+1] := LF ;
end ;
until i = 0 ;
EscPressed := (Key = EscapeKey) ;
SetBottomLine ('') ;
CursorTo (OldXpos,OldYpos) ;
SetCursor (OLdCursorType) ;
end ;
{-----------------------------------------------------------------------------}
{ Prompts the user to enter a numeric value. If a string is entered that can }
{ not be interpreted as a numeric value, or if the value is not within the }
{ limits MinValue..MaxValue, a beep is given and the procedure is repeated. }
{ Pressing Escape will restore the old value of W. }
{-----------------------------------------------------------------------------}
procedure EnterWord (var W:word ; Prompt:string ; MinValue,MaxValue:word) ;
var S:string ;
Code : integer ;
OK : boolean ;
begin
Str (W,S) ;
repeat EnterString (S,Prompt,5,False,True) ;
Val (S,W,Code) ;
OK := (Code = 0) and (W >= MinValue) and (W <= MaxValue) ;
if not OK then WarningBeep ;
until OK ;
end ;
{-----------------------------------------------------------------------------}
{ Prompts the user to enter a boolean value. The current value is displayed, }
{ and can be changed with the space bar or the cursor keys. Pressing Return }
{ stores the value and exits, and the Y and N keys may be used for entering }
{ the desired value directly. Pressing Escape will restore the old value. }
{-----------------------------------------------------------------------------}
procedure EnterBoolean (var B:boolean ; Prompt:string ) ;
var OldB : boolean ;
OldCursorType : byte ;
Key : word ;
begin
OldCursorType := GetCursor ;
SetCursor (Inactive) ;
OldB := B ;
repeat if B
then SetBottomLine (Prompt+' Yes')
else SetBottomLine (Prompt+' No') ;
Key := GetKeyNr ;
case Key of
32,328,331,333,336 : B := not B ;
78,110 : begin
B := False ;
Key := ReturnKey ;
end ;
89,121 : begin
B := True ;
Key := ReturnKey ;
end ;
EscapeKey : B := OldB ;
ReturnKey : ;
else WarningBeep ;
end ;
until (Key = ReturnKey) or (Key = EscapeKey) ;
EscPressed := (Key = EscapeKey) ;
SetBottomLine ('') ;
SetCursor (OldCursorType) ;
end ;
{-----------------------------------------------------------------------------}
{ Saves the file in workspace <Wsnr> to disk. If there is no name yet, }
{ the user is prompted for one. }
{-----------------------------------------------------------------------------}
procedure SaveFile (Wsnr:byte) ;
var F : file ;
Counter : word ;
DotPos : byte ;
BAKfilename : PathStr ;
OldStatusLine : ScreenBlockPtr ;
begin
{ save contents of statusline }
SaveArea (1,LinesOnScreen,ColsOnScreen,LinesOnScreen,OldStatusLine) ;
with Workspace[Wsnr] do
begin
EscPressed := False ;
if Length(Name) = 0
then begin
EnterString (Name,'Saving file. Filename: ',79,True,True) ;
if Length(Name) = 0
then EscPressed := True
else if Wildcarded(Name)
then begin
ErrorMessage (16) ;
EscPressed := True ;
end
else Name := FExpand (Name) ;
end ;
if not EscPressed
then begin
Message ('Saving file '+Name) ;
if (Config.Setup.MakeBAKfile) and (Exists(Name))
then begin
{ determine name of backup file }
DotPos := Pos ('.',Name) ;
if DotPos = 0
then BAKfilename := Name + '.BAK'
else BAKfilename := Copy(Name,1,DotPos)+'BAK' ;
{ delete old backup file if present }
if Exists (BAKfilename)
then begin
Assign (F,BAKfilename) ;
Erase (F) ;
end ;
{ rename file to backup file }
Assign (F,Name) ;
Rename (F,BAKfilename) ;
end ;
Assign (F,Name) ;
Rewrite (F,BufferSize) ;
CheckDiskError ;
if DiskError = 0
then begin
{ save contents of buffer to file }
BlockWrite (F,Buffer^,1) ;
CheckDiskError ;
Close (F) ;
if DiskError = 0
then { save was successful }
ChangesMade := False ;
end ;
GetTime (LastTimeSaved[1],LastTimeSaved[2],
LastTimeSaved[3],LastTimeSaved[4]) ;
MessageRead := True ;
end ;
end ; { of with }
{ restore status line }
RestoreArea (1,LinesOnScreen,ColsOnScreen,LinesOnScreen,OldStatusLine) ;
end ;
{-----------------------------------------------------------------------------}
{ Displays a table with the entire IBM character set, from which the user }
{ can then make a choice, using the cursor and Return keys. Pressing Escape }
{ will return a value of 279. Cursor shape and position and screen contents }
{ are saved, and restored on exit. }
{-----------------------------------------------------------------------------}
function GetKeyFromTable : word ;
var OldAttr,OldXpos,OldYpos,OldCursorType,KeyNr,Counter : byte ;
OldDisplayContents : ScreenBlockPtr ;
ScrEl : ScreenElement ;
SelectKey : word ;
begin
OldXpos := WhereX ;
OldYpos := WhereY ;
OldCursorType := GetCursor ;
OldAttr := TextAttr ;
TextAttr := ScreenColorArray[Config.Setup.ScreenColors].NormAttr ;
SaveArea (7,2,74,21,OldDisplayContents) ;
SetCursor (Inactive) ;
{ put empty table on screen }
PutFrame (7,2,74,21,Quasi3DFrame) ;
ClearArea (8,3,73,20) ;
ScrEl.Attribute := TextAttr ;
{ fill table }
for Counter := 0 to 255 do
begin
ScrEl.Contents := Chr(Counter) ;
DisplayPtr^[4+(Counter div 32)*2,9+(Counter mod 32)*2] := word(ScrEl) ;
end ;
KeyNr := 0 ;
repeat GotoXY (9,20) ; Write ('ASCII value: ',KeyNr:3) ;
{ show selected character }
with ScreenColorArray[Config.Setup.ScreenColors] do
ScrEl.Attribute := BlockAttr ;
ScrEl.Contents := Chr(KeyNr) ;
DisplayPtr^[4+(KeyNr div 32)*2,9+(KeyNr mod 32)*2] := word(ScrEl) ;
{ read a key from the keyboard }
SelectKey := ReadKeyNr ;
{ hide previously selected character }
ScrEl.Attribute := TextAttr ;
ScrEl.Contents := Chr(KeyNr) ;
DisplayPtr^[4+(KeyNr div 32)*2,9+(KeyNr mod 32)*2] := word(ScrEl) ;
case SelectKey of
328 : { up } Dec (KeyNr,32) ;
336 : { down } Inc (KeyNr,32) ;
331 : { left } Dec (KeyNr) ;
333 : { right } Inc (KeyNr) ;
371 : { ^left } Dec (KeyNr,8) ;
372 : { ^right } Inc (KeyNr,8) ;
ReturnKey : ;
EscapeKey : ;
else WarningBeep ;
end ; { of case }
ScrEl.Attribute := TextAttr ;
ScrEl.Contents := Chr(KeyNr) ;
DisplayPtr^[4+(KeyNr div 32)*2,9+(KeyNr mod 32)*2] := word(ScrEl) ;
until (SelectKey = ReturnKey) or (SelectKey = EscapeKey) ;
RestoreArea (7,2,74,21,OldDisplayContents) ;
TextAttr := OldAttr ;
GotoXY (OldXpos,OldYpos) ;
SetCursor (OldCursorType) ;
if SelectKey = EscapeKey
then GetKeyFromTable := 279 { alt-I }
else GetKeyFromTable := KeyNr ;
end ;
{-----------------------------------------------------------------------------}
{ Displays help screens containing the key definitions }
{ Cursor shape and position and screen contents are saved, and }
{ restored on exit. }
{-----------------------------------------------------------------------------}
procedure DisplayHelp ;
var OldDisplayContents : ScreenBlockPtr ;
OldXpos,OldYpos,OldCursorType : byte ;
begin
OldXpos := WhereX ;
OldYpos := WhereY ;
OldCursorType := GetCursor ;
SetCursor (Inactive) ;
SaveArea (1,1,ColsOnScreen,LinesOnScreen,OldDisplayContents) ;
ClearArea (1,1,ColsOnScreen,NrOfTextLines) ;
Writeln (' ┌────────────────────┬─────────────────┐') ;
Writeln (' │ NORMAL KEY │ CONTROL+KEY │') ;
Writeln ('┌─────────┼────────────────────┼─────────────────┤') ;
Writeln ('│ ─ │ PREVIOUS CHARACTER │ PREVIOUS WORD │') ;
Writeln ('│ ─ │ NEXT CHARACTER │ NEXT WORD │') ;
Writeln ('│ │ PREVIOUS LINE │ │') ;
Writeln ('│ │ NEXT LINE │ │') ;
Writeln ('│ Home │ BEGIN OF LINE │ BEGIN OF SCREEN │') ;
Writeln ('│ End │ END OF LINE │ END OF SCREEN │') ;
Writeln ('│ Page Up │ PREVIOUS SCREEN │ BEGIN OF TEXT │') ;
Writeln ('│ Page Dn │ NEXT SCREEN │ END OF TEXT │') ;
Writeln ('└─────────┴────────────────────┴─────────────────┘') ;
Writeln ;
Writeln ('┌───────────┬───────────────────────────────┐') ;
Writeln ('│ Insert │ TOGGLE INSERT/OVERWRITE MODE │') ;
Writeln ('│ Delete │ REMOVE CHARACTER UNDER CURSOR │') ;
Writeln ('│ Backspace │ REMOVE PREVIOUS CHARACTER │') ;
Writeln ('└───────────┴───────────────────────────────┘') ;
Pause ;
if not EscPressed
then
begin
ClearArea (1,1,ColsOnScreen,NrOfTextLines) ;
Writeln (' ┌─────────────┬───────────────────────────────┐') ;
Writeln (' │ NORMAL KEY │ SHIFT+KEY │') ;
Writeln ('┌─────┼─────────────┼───────────────────────────────┤') ;
Writeln ('│ F1 │ HELP │ SETUP │') ;
Writeln ('│ F2 │ SAVE FILE │ WRITE TO FILE │') ;
Writeln ('│ F3 │ LOAD FILE │ INSERT FILE │') ;
Writeln ('│ F4 │ FIND * │ FIND & REPLACE * │') ;
Writeln ('│ F5 │ PUT MARK │ ERASE MARK │') ;
Writeln ('│ F6 │ CUT BLOCK │ DELETE BLOCK │') ;
Writeln ('│ F7 │ COPY BLOCK │ COMPARE BLOCK TO PASTE BUFFER │') ;
Writeln ('│ F8 │ PASTE BLOCK │ PRINT BLOCK │') ;
Writeln ('│ F9 │ NEXT WINDOW │ PREVIOUS WINDOW │') ;
Writeln ('│ F10 │ DOS COMMAND │ │') ;
Writeln ('└─────┴─────────────┴───────────────────────────────┘') ;
Writeln ;
Writeln (' *: FIND/REPLACE OPTIONS') ;
Writeln ;
Writeln (' I = IGNORE CASE') ;
Writeln (' N = NO QUERY DURING REPLACE') ;
Writeln (' R = REVERSE DIRECTION') ;
Pause ;
end ; { of if }
if not EscPressed
then
begin
ClearArea (1,1,ColsOnScreen,NrOfTextLines) ;
Writeln ('┌─────────┬───────────────────────────┐') ;
Writeln ('│ ALT+KEY │ ACTION │') ;
Writeln ('├─────────┼───────────────────────────┤') ;
Writeln ('│ 1..9,0 │ PLAY MACRO NR 1,..9,10 │') ;
Writeln ('│ A │ SWITCH TO WINDOW A │') ;
Writeln ('│ C │ CENTER LINE │') ;
Writeln ('│ D │ DEFINE KEYBOARD MACRO │') ;
Writeln ('│ E │ EJECT PRINTER PAGE │') ;
Writeln ('│ F │ FORMAT PARAGRAPH │') ;
Writeln ('│ G │ GET SAVED POSITION │') ;
Writeln ('│ I │ IBM CHAR.SET (ASCII TABLE)│') ;
Writeln ('│ J │ JUSTIFY LINE RIGHT │') ;
Writeln ('│ L │ DELETE LINE │') ;
Writeln ('│ M │ MATCH BRACKETS ({[<>]}) │') ;
Writeln ('│ N │ NEW (CLEAR BUFFER) │') ;
Writeln ('│ P │ PRINT ENTIRE FILE │') ;
Writeln ('│ R │ REPEAT LAST FIND/REPLACE │') ;
Writeln ('│ S │ SAVE POSITION │') ;
Writeln ('│ T │ TOGGLE CASE IN BLOCK │') ;
Writeln ('│ W │ DELETE WORD FORWARD │') ;
Writeln ('│ X │ EXIT PROGRAM │') ;
Writeln ('└─────────┴───────────────────────────┘') ;
Pause ;
end ; { of if }
RestoreArea (1,1,ColsOnScreen,LinesOnScreen,OldDisplayContents) ;
GotoXY (OldXpos,OldYpos) ;
SetCursor (OldCursorType) ;
end ;
{-----------------------------------------------------------------------------}
{ Returns a key number, read from a macro if one is running, or from the }
{ keyboard otherwise. The procedure takes care of displaying ASCII tables, }
{ help screens and of storing the number of the key in the macro space }
{ if a macro is being defined. }
{-----------------------------------------------------------------------------}
function GetKeyNr : word ;
var KeyNr : word ;
Hrs,Mins,Secs,Sec100s,TimePassed : word ;
WsNr : byte ;
begin
if MacroStackpointer <> Inactive
then begin
{ get keynumber from macro }
with Config do
begin
Keynr := Macro.Contents[MacroStack[MacroStackpointer].Macronr,
MacroStack[MacroStackpointer].Index] ;
repeat { set Index to next keynumber in macro sequence }
Inc (MacroStack[MacroStackpointer].Index) ;
if MacroStack[MacroStackpointer].Index >
Macro.Length[MacroStack[MacroStackpointer].Macronr]
then begin
{ macro finished, decrease stackpointer }
Dec (MacroStackpointer) ;
end ;
until (MacroStackpointer = Inactive) or
(MacroStack[MacroStackpointer].Index <=
Macro.Length[MacroStack[MacroStackpointer].Macronr]) ;
end ; { of with }
end
else begin
{ get keynumber from keyboard }
repeat GetTime (Hrs,Mins,Secs,Sec100s) ;
for WsNr := 1 to NrOfWorkspaces do
with Workspace[WsNr] do
begin
{ calculate time since last save of file in Workspace }
if LastTimeSaved[1] > Hrs
then TimePassed := 60 * (24+Hrs-LastTimeSaved[1])
else TimePassed := 60 * (Hrs-LastTimeSaved[1]) ;
if LastTimeSaved[2] > Mins
then Dec (TimePassed,LastTimeSaved[2]-Mins)
else Inc (TimePassed,Mins-LastTimeSaved[2]) ;
if LastTimeSaved[3] > Secs
then Dec (TimePassed) ;
if (Config.Setup.SaveInterval <> Inactive) and
(TimePassed >= Config.Setup.SaveInterval) and
ChangesMade and
(Length(Name) <> 0)
then SaveFile(Wsnr) ;
end ; { of with }
until KeyPressed ;
repeat KeyNr := ReadKeyNr ;
if KeyNr = 315 { F1 } then DisplayHelp ;
if KeyNr = 279 { alt-I } then KeyNr := GetKeyFromTable ;
until (KeyNr <> 315) and (KeyNr <> 279) ;
if Config.Setup.Keyclick
then begin
Sound(440) ;
Delay(2) ;
NoSound ;
end ;
if (MacroDefining <> Inactive) and (KeyNr <> 288 { alt-D })
then begin
if Config.Macro.Length[MacroDefining] = MaxMacroLength
then begin
{ macro too long }
ErrorMessage (6) ;
MacroDefining := Inactive ;
end
else begin
{ add keynumber to macro }
Inc (Config.Macro.Length[MacroDefining]) ;
Config.Macro.Contents[MacroDefining,
Config.Macro.Length[MacroDefining]] := KeyNr ;
end ;
end ;
end ; { of if }
GetKeyNr := KeyNr ;
MessageRead := True ;
end ;
{-----------------------------------------------------------------------------}
{ Puts a question on the bottom screen line and then waits until the Y, N or }
{ Escape key is pressed. The Y key produces a True result, the N and Escape }
{ a False function result. }
{-----------------------------------------------------------------------------}
function Answer (Question:string) : boolean ;
var Key : word ;
OldX,OldY,OldCursorType : byte ;
begin
OldX := WhereX ;
OldY := WhereY ;
OldCursorType := GetCursor ;
Message (Question+' (Y/N) ') ;
CursorTo (Length(Question)+8,LinesOnScreen) ;
SetCursor (Config.Setup.CursorType) ;
repeat Key := GetKeyNr
until (Key in [78,89,110,121]) or
(Key = EscapeKey) ;
Answer := (Key = 89) or (Key = 121) ;
EscPressed := (Key = EscapeKey) ;
CursorTo (OldX,OldY) ;
SetCursor (OldCursorType) ;
end ;
{-----------------------------------------------------------------------------}
{ Displays the Choices string on the bottom screen line, and waits for the }
{ user to make a choice, which is made by pressing a letter key which, }
{ converted to upper case, also occurs in the string. This key is then }
{ returned as the function result. Exit by pressing Escape is also possible. }
{-----------------------------------------------------------------------------}
function Choose (Choices:string) : char ;
var Key : word ;
KeyC : char ;
Valid : boolean ;
begin
SetBottomLine (Choices) ;
repeat Key := GetKeyNr ;
if Key < 256
then KeyC := UpCase(Chr(Key))
else KeyC := #0 ;
Valid := ((KeyC in ['A'..'Z']) and (Pos(KeyC,Choices) <> 0)) or
(Key = EscapeKey) ;
if not Valid
then WarningBeep ;
until Valid ;
EscPressed := (Key = EscapeKey) ;
Choose := KeyC ;
Message ('') ;
end ;
{-----------------------------------------------------------------------------}
end.