home *** CD-ROM | disk | FTP | other *** search
- 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.