| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849 |
- MODULE Shell ;
- (* TP3 main-menu shell. Draws the Turbo Pascal 3.0 screen with ANSI
- escapes and dispatches on the same command letters as the original
- (TPSRC4 kmenu / kcmdtab). Editor, compiler and interpreter are
- placeholders for now; the shell logic (files, directory, options,
- save/load with .BAK) mirrors the original closely. *)
- FROM Term IMPORT
- Open, Close, ClrScr, GotoXY, PutCh, PutStr, PutCard, PutLongCard,
- ScrnWide, Marked, Normal, GetCh, Beep ;
- FROM Posix IMPORT
- read, write, open, close, unlink, rename,
- getcwd, chdir, opendir, readdir, closedir, statvfs,
- Dir, dirent, statvfsbuf ;
- FROM Compiler IMPORT Compile, CodeBytes, DataBytes ;
- FROM Editor IMPORT Run ;
- FROM TextBuf IMPORT
- TextLimit, Clear, Length, CharAt, InsertCh ;
- FROM SYSTEM IMPORT ADR, ADDRESS, BYTE ;
- CONST
- O_RDONLY = 0 ; (* linux *)
- VAR
- drive : CHAR ;
- workName : ARRAY [0..255] OF CHAR ;
- mainName : ARRAY [0..255] OF CHAR ;
- changed : BOOLEAN ;
- codeDest : CARDINAL ; (* 0=Memory, 1=COM, 2=CHN *)
- errNo, errPos : CARDINAL ;
- minCode, minData, minStack, maxStack : CARDINAL ;
- paramLine : ARRAY [0..255] OF CHAR ;
- (* ------------------------------------------------------------------ *)
- (* string helpers *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE StrLen (VAR s : ARRAY OF CHAR) : CARDINAL ;
- VAR i : CARDINAL ;
- BEGIN
- i := 0 ;
- WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
- INC (i)
- END ;
- RETURN i
- END StrLen ;
- PROCEDURE StrClear (VAR s : ARRAY OF CHAR) ;
- BEGIN
- s [0] := 0C
- END StrClear ;
- PROCEDURE StrCopy (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
- VAR i : CARDINAL ;
- BEGIN
- i := 0 ;
- LOOP
- IF i > HIGH (dst) THEN
- dst [HIGH (dst)] := 0C ;
- EXIT
- END ;
- IF i > HIGH (src) THEN
- dst [i] := 0C ;
- EXIT
- END ;
- IF src [i] = 0C THEN
- dst [i] := 0C ;
- EXIT
- END ;
- dst [i] := src [i] ;
- INC (i)
- END
- END StrCopy ;
- PROCEDURE StrAppend (VAR dst : ARRAY OF CHAR ; suffix : ARRAY OF CHAR) ;
- VAR i, j : CARDINAL ;
- BEGIN
- i := StrLen (dst) ;
- j := 0 ;
- LOOP
- IF i > HIGH (dst) THEN
- EXIT
- END ;
- IF j > HIGH (suffix) THEN
- dst [i] := 0C ;
- EXIT
- END ;
- IF suffix [j] = 0C THEN
- dst [i] := 0C ;
- EXIT
- END ;
- dst [i] := suffix [j] ;
- INC (i) ;
- INC (j)
- END
- END StrAppend ;
- PROCEDURE StrEq (VAR a, b : ARRAY OF CHAR) : BOOLEAN ;
- VAR i : CARDINAL ;
- BEGIN
- i := 0 ;
- LOOP
- IF (i > HIGH (a)) OR (i > HIGH (b)) THEN
- RETURN FALSE
- END ;
- IF (a [i] = 0C) AND (b [i] = 0C) THEN
- RETURN TRUE
- END ;
- IF a [i] # b [i] THEN
- RETURN FALSE
- END ;
- INC (i)
- END ;
- RETURN FALSE
- END StrEq ;
- PROCEDURE Upper (ch : CHAR) : CHAR ;
- BEGIN
- IF (ch >= "a") AND (ch <= "z") THEN
- RETURN CHR (ORD (ch) - (ORD ("a") - ORD ("A")))
- END ;
- RETURN ch
- END Upper ;
- PROCEDURE CrLf ;
- BEGIN
- PutCh (CHR (13)) ;
- PutCh (CHR (10))
- END CrLf ;
- PROCEDURE GetCwd (VAR buf : ARRAY OF CHAR) ;
- VAR i : CARDINAL ;
- BEGIN
- IF getcwd (ADR (buf), 4096) = NIL THEN
- buf [0] := 0C
- END
- END GetCwd ;
- (* ------------------------------------------------------------------ *)
- (* marks one command letter then prints the rest of the label *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE Key (letter, rest : ARRAY OF CHAR) ;
- BEGIN
- Marked ;
- PutCh (letter [0]) ;
- Normal ;
- PutStr (rest)
- END Key ;
- (* ------------------------------------------------------------------ *)
- (* input line editing (no echo from termios): CR or LF ends the line, *)
- (* backspace deletes the last char, the result is stored 0C-terminated*)
- (* ------------------------------------------------------------------ *)
- PROCEDURE ReadLine (VAR s : ARRAY OF CHAR) : CARDINAL ;
- VAR len : CARDINAL ;
- ch : CHAR ;
- BEGIN
- StrClear (s) ;
- len := 0 ;
- LOOP
- GetCh (ch) ;
- IF (ch = CHR (13)) OR (ch = CHR (10)) THEN
- PutCh (CHR (13)) ;
- PutCh (CHR (10)) ;
- EXIT
- ELSIF (ch = CHR (8)) OR (ch = CHR (127)) THEN
- IF len > 0 THEN
- DEC (len) ;
- PutStr ("[D [D") (* backspace over the char *)
- END
- ELSIF ch = CHR (27) THEN
- (* ESC: cancel the current edit *)
- EXIT
- ELSIF (ch >= " ") AND (ch <= "~") AND (len < HIGH (s)) THEN
- s [len] := ch ;
- INC (len) ;
- PutCh (ch)
- END
- END ;
- s [len] := 0C ;
- RETURN len
- END ReadLine ;
- PROCEDURE Pause ;
- VAR ch : CHAR ;
- BEGIN
- Beep ;
- GetCh (ch)
- END Pause ;
- PROCEDURE WaitEsc ;
- VAR ch : CHAR ;
- BEGIN
- LOOP
- GetCh (ch) ;
- IF (ch = CHR (27)) OR (ch = "q") OR (ch = "Q") THEN
- EXIT
- END
- END
- END WaitEsc ;
- (* return true if the user confirms with Y / y *)
- PROCEDURE Confirm (prompt : ARRAY OF CHAR) : BOOLEAN ;
- VAR ch : CHAR ;
- BEGIN
- PutStr (prompt) ;
- GetCh (ch) ;
- IF (ch = "y") OR (ch = "Y") THEN
- CrLf ;
- RETURN TRUE
- END ;
- CrLf ;
- RETURN FALSE
- END Confirm ;
- (* ------------------------------------------------------------------ *)
- (* file name handling *)
- (* ------------------------------------------------------------------ *)
- (* Does the name contain a '.' ? *)
- PROCEDURE HasExt (VAR s : ARRAY OF CHAR) : BOOLEAN ;
- VAR i : CARDINAL ;
- BEGIN
- i := 0 ;
- WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
- IF s [i] = "." THEN
- RETURN TRUE
- END ;
- INC (i)
- END ;
- RETURN FALSE
- END HasExt ;
- (* replaces the current work file, appending .PAS when needed *)
- PROCEDURE SetWorkName (VAR s : ARRAY OF CHAR) ;
- BEGIN
- StrCopy (workName, s) ;
- IF NOT HasExt (workName) THEN
- StrAppend (workName, ".PAS")
- END
- END SetWorkName ;
- (* ------------------------------------------------------------------ *)
- (* buffered save of the work file: .BAK = old version, then ^Z *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE SaveWorkFile ;
- VAR fd : INTEGER ;
- path : ARRAY [0..511] OF CHAR ;
- w : LONGINT ;
- i : CARDINAL ;
- msg : ARRAY [0..255] OF CHAR ;
- b : BYTE ;
- BEGIN
- IF StrLen (workName) = 0 THEN
- PutStr (" ...work file not set") ;
- CrLf ;
- Pause ;
- RETURN
- END ;
- StrClear (msg) ;
- StrAppend (msg, "Saving A:") ;
- StrAppend (msg, workName) ;
- PutStr (msg) ;
- StrClear (path) ;
- StrAppend (path, workName) ;
- StrAppend (path, ".BAK") ;
- w := unlink (ADR (path)) ; (* drop old backup *)
- StrClear (path) ;
- StrAppend (path, workName) ;
- StrAppend (path, ".BAK") ;
- StrClear (msg) ;
- StrAppend (msg, workName) ;
- w := rename (ADR (msg), ADR (path)) ; (* old version -> .BAK *)
- StrClear (path) ;
- StrAppend (path, workName) ;
- fd := open (ADR (path), 1 + 512 + 64, 420) ; (* O_WRONLY|O_TRUNC|O_CREAT, 0644 *)
- IF fd < 0 THEN
- CrLf ;
- PutStr (" ...cannot create file") ;
- Pause ;
- RETURN
- END ;
- i := 0 ;
- WHILE i < Length () DO
- IF CharAt (i) = CHR (13) THEN
- b := CHR (13) ;
- w := write (fd, ADR (b), 1) ;
- b := CHR (10) ;
- w := write (fd, ADR (b), 1)
- ELSE
- b := VAL (BYTE, ORD (CharAt (i))) ;
- w := write (fd, ADR (b), 1)
- END ;
- INC (i)
- END ;
- b := CHR (26) ; (* EOF marker ^Z, TP3 style *)
- w := write (fd, ADR (b), 1) ;
- w := close (fd) ;
- changed := FALSE ;
- CrLf
- END SaveWorkFile ;
- (* ------------------------------------------------------------------ *)
- (* load a file into the text buffer; stop at ^Z or TextLimit *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE LoadWorkFile ;
- VAR fd : INTEGER ;
- path : ARRAY [0..511] OF CHAR ;
- k : LONGINT ;
- b : BYTE ;
- prevCR, tooBig : BOOLEAN ;
- BEGIN
- StrClear (path) ;
- StrAppend (path, workName) ;
- fd := open (ADR (path), O_RDONLY, 0) ;
- IF fd < 0 THEN
- PutStr ("New File") ;
- CrLf ;
- Clear ;
- changed := FALSE ;
- Pause ;
- RETURN
- END ;
- tooBig := FALSE ;
- prevCR := FALSE ;
- Clear ;
- LOOP
- IF Length () >= TextLimit THEN
- tooBig := TRUE ;
- EXIT
- END ;
- k := read (fd, ADR (b), 1) ;
- IF k # 1 THEN
- EXIT
- END ;
- IF b = CHR (26) THEN
- EXIT
- ELSIF b = CHR (10) THEN
- IF NOT prevCR THEN
- InsertCh (Length (), CHR (13)) (* lone LF -> CR *)
- END ;
- prevCR := FALSE
- ELSIF b = CHR (13) THEN
- InsertCh (Length (), CHR (13)) ;
- prevCR := TRUE
- ELSE
- InsertCh (Length (), CHR (ORD (b))) ;
- prevCR := FALSE
- END
- END ;
- k := close (fd) ;
- IF tooBig THEN
- PutStr ("File too big") ;
- CrLf
- END ;
- changed := FALSE ;
- Pause
- END LoadWorkFile ;
- (* ------------------------------------------------------------------ *)
- (* directory listing (kdir) *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE MatchMask (VAR m, n : ARRAY OF CHAR) : BOOLEAN ;
- VAR mi, ni, saveMi, saveNi : CARDINAL ;
- isAll : BOOLEAN ;
- BEGIN
- (* DOS-style: "*.*" and "*" mean "everything" *)
- isAll := TRUE ;
- mi := 0 ;
- WHILE (mi <= HIGH (m)) AND (m [mi] # 0C) DO
- IF NOT ((m [mi] = "*") OR (m [mi] = ".")) THEN
- isAll := FALSE
- END ;
- INC (mi)
- END ;
- IF isAll THEN
- RETURN TRUE
- END ;
- mi := 0 ;
- ni := 0 ;
- saveMi := 0 ;
- saveNi := 0 ;
- LOOP
- (* mask exhausted *)
- IF (mi <= HIGH (m)) AND (m [mi] = "*") THEN
- saveMi := mi ;
- WHILE (mi <= HIGH (m)) AND (m [mi] = "*") DO
- INC (mi)
- END ;
- IF mi > HIGH (m) THEN
- RETURN TRUE
- END ;
- saveNi := ni
- ELSIF (mi > HIGH (m)) OR (m [mi] = 0C) THEN
- RETURN (ni <= HIGH (n)) AND (n [ni] = 0C)
- ELSIF (ni <= HIGH (n)) AND (n [ni] # 0C) AND
- (Upper (m [mi]) = Upper (n [ni])) THEN
- INC (mi) ;
- INC (ni)
- ELSIF saveMi > 0 THEN
- INC (saveNi) ;
- IF saveNi > HIGH (n) THEN
- RETURN FALSE
- END ;
- ni := saveNi ;
- mi := saveMi + 1
- ELSIF (ni > HIGH (n)) OR (n [ni] = 0C) THEN
- RETURN FALSE
- ELSE
- RETURN FALSE
- END
- END ;
- RETURN FALSE
- END MatchMask ;
- PROCEDURE DirCmd ;
- VAR mask : ARRAY [0..255] OF CHAR ;
- d : Dir ;
- p : POINTER TO dirent ;
- count : CARDINAL ;
- freeK : LONGCARD ;
- sv : statvfsbuf ;
- i : CARDINAL ;
- w : INTEGER ;
- BEGIN
- PutStr ("Dir mask: ") ;
- IF ReadLine (mask) = 0 THEN
- StrCopy (mask, "*.*")
- END ;
- CrLf ;
- d := opendir (ADR (".")) ;
- IF d = NIL THEN
- PutStr ("No files") ;
- CrLf ;
- Pause ;
- RETURN
- END ;
- count := 0 ;
- LOOP
- p := readdir (d) ;
- IF p = NIL THEN
- EXIT
- END ;
- IF (p^.d_name [0] # ".") AND
- (MatchMask (mask, p^.d_name)) THEN
- INC (count) ;
- PutStr (p^.d_name) ;
- i := 1 + (12 - StrLen (p^.d_name) MOD 12) ;
- IF i > 12 THEN
- i := 12
- END ;
- ScrnWide (i)
- END
- END ;
- w := closedir (d) ;
- CrLf ;
- IF count = 0 THEN
- PutStr ("No files") ;
- CrLf
- END ;
- IF statvfs (ADR ("."), ADR (sv)) = 0 THEN
- freeK := (sv.f_bavail * sv.f_frsize) DIV 1024 ;
- PutLongCard (freeK) ;
- PutStr ("k bytes free") ;
- CrLf
- END ;
- Pause
- END DirCmd ;
- (* ------------------------------------------------------------------ *)
- (* main menu *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE DrawMenu ;
- VAR cwd : ARRAY [0..4095] OF CHAR ;
- freeB : CARDINAL ;
- i : CARDINAL ;
- BEGIN
- ClrScr ;
- GotoXY (1, 1) ;
- Key ("L", "ogged drive: ") ;
- PutCh (drive) ;
- GetCwd (cwd) ;
- GotoXY (2, 1) ;
- Key ("A", "ctive directory: ") ;
- PutStr (cwd) ;
- GotoXY (4, 1) ;
- Key ("W", "ork file: A:") ;
- PutStr (workName) ;
- GotoXY (5, 1) ;
- Key ("M", "ain file: A:") ;
- PutStr (mainName) ;
- GotoXY (7, 1) ;
- Key ("E", "dit ") ;
- Key ("C", "ompile ") ;
- Key ("R", "un ") ;
- Key ("S", "ave") ;
- GotoXY (9, 1) ;
- Key ("D", "ir ") ;
- Key ("Q", "uit compiler ") ;
- Key ("O", "ptions") ;
- GotoXY (11, 1) ;
- PutStr ("Text: ") ;
- PutCard (Length ()) ;
- PutStr (" bytes") ;
- freeB := TextLimit - Length ();
- GotoXY (12, 1) ;
- PutStr ("Free: ") ;
- PutCard (freeB) ;
- PutStr (" bytes") ;
- GotoXY (14, 1) ;
- Marked ;
- PutCh (">") ;
- Normal
- END DrawMenu ;
- (* ------------------------------------------------------------------ *)
- (* command handlers *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE CmdLogDrive ;
- VAR nm : ARRAY [0..255] OF CHAR ;
- ln : CARDINAL ;
- BEGIN
- ClrScr ;
- GotoXY (1, 1) ;
- PutStr ("New drive: ") ;
- ln := ReadLine (nm) ;
- IF ln = 1 THEN
- drive := Upper (nm [0]) ;
- IF (drive < "A") OR (drive > "P") THEN
- drive := "A"
- END
- ELSIF ln > 1 THEN
- (* treat as a directory instead (linux has no real drives) *)
- IF chdir (ADR (nm)) # 0 THEN
- PutStr ("File not found") ;
- CrLf ;
- Pause
- END
- END
- END CmdLogDrive ;
- PROCEDURE CmdActDir ;
- VAR nm : ARRAY [0..255] OF CHAR ;
- BEGIN
- ClrScr ;
- GotoXY (1, 1) ;
- PutStr ("New directory: ") ;
- IF ReadLine (nm) > 0 THEN
- IF chdir (ADR (nm)) # 0 THEN
- PutStr ("File not found") ;
- CrLf ;
- Pause
- END
- END
- END CmdActDir ;
- PROCEDURE CmdWorkFile ;
- VAR nm : ARRAY [0..255] OF CHAR ;
- txtTitle : ARRAY [0..511] OF CHAR ;
- BEGIN
- ClrScr ;
- GotoXY (1, 1) ;
- PutStr ("Work file name: ") ;
- IF ReadLine (nm) > 0 THEN
- IF changed THEN
- CrLf ;
- PutStr (" ") ;
- IF Confirm ("Save current work file now (Y/N) ?") THEN
- SaveWorkFile
- END
- END ;
- ClrScr ;
- GotoXY (1, 1) ;
- SetWorkName (nm) ;
- StrClear (txtTitle) ;
- StrAppend (txtTitle, "Loading A:") ;
- StrAppend (txtTitle, workName) ;
- PutStr (txtTitle) ;
- CrLf ;
- LoadWorkFile
- END
- END CmdWorkFile ;
- PROCEDURE CmdMainFile ;
- VAR nm : ARRAY [0..255] OF CHAR ;
- BEGIN
- ClrScr ;
- GotoXY (1, 1) ;
- PutStr ("Main file name: ") ;
- IF ReadLine (nm) > 0 THEN
- StrCopy (mainName, nm) ;
- IF NOT HasExt (mainName) THEN
- StrAppend (mainName, ".PAS")
- END
- END
- END CmdMainFile ;
- PROCEDURE CmdCompile ;
- BEGIN
- ClrScr ;
- GotoXY (1, 1) ;
- IF Compile (errNo, errPos) THEN
- PutStr ("Compiled OK - code ") ;
- PutCard (CodeBytes ()) ;
- PutStr (" bytes, data ") ;
- PutCard (DataBytes ()) ;
- PutStr (" bytes (TP3 option O not yet run)") ;
- CrLf ;
- PutStr ("press ESC to return to the editor") ;
- CrLf ;
- WaitEsc
- ELSE
- PutStr ("TP3-style error ") ;
- PutCard (errNo) ;
- PutStr (" at relative pos ") ;
- PutCard (errPos) ;
- CrLf ;
- PutStr ("(jump to editor position not yet wired)") ;
- CrLf ;
- WaitEsc
- END
- END CmdCompile ;
- PROCEDURE CmdRun ;
- BEGIN
- ClrScr ;
- GotoXY (1, 1) ;
- PutStr ("Interpreter pending - compiled code is in memory") ;
- CrLf ;
- PutStr ("(TP3 option R / debugger not yet wired)") ;
- CrLf ;
- WaitEsc
- END CmdRun ;
- PROCEDURE CmdEditor ;
- VAR edChanged : BOOLEAN ;
- BEGIN
- IF StrLen (workName) = 0 THEN
- (* kgetfn: no work file yet -> prompt just like W does *)
- CmdWorkFile ;
- IF StrLen (workName) = 0 THEN
- RETURN
- END
- END ;
- edChanged := FALSE ;
- Run (drive, workName, edChanged) ;
- IF edChanged THEN
- changed := TRUE
- END
- END CmdEditor ;
- (* ------------------------------------------------------------------ *)
- (* TP3 "Options" submenu (optmenu) *)
- (* ------------------------------------------------------------------ *)
- PROCEDURE PutHex (n : CARDINAL) ;
- VAR dig : ARRAY [0..7] OF CHAR ;
- i, d : CARDINAL ;
- BEGIN
- i := 0 ;
- LOOP
- d := n MOD 16 ;
- IF d < 10 THEN
- dig [i] := CHR (ORD ("0") + d)
- ELSE
- dig [i] := CHR (ORD ("A") + d - 10)
- END ;
- n := n DIV 16 ;
- INC (i) ;
- IF (n = 0) OR (i = 8) THEN
- EXIT
- END
- END ;
- WHILE i > 0 DO
- DEC (i) ;
- PutCh (dig [i])
- END
- END PutHex ;
- PROCEDURE OptionsMenu ;
- VAR ch : CHAR ;
- s : ARRAY [0..255] OF CHAR ;
- done : BOOLEAN ;
- BEGIN
- done := FALSE ;
- REPEAT
- ClrScr ;
- GotoXY (1, 1) ;
- Marked ; PutCh ("M") ; Normal ;
- PutStr ("emory ") ;
- Marked ; PutCh ("C") ; Normal ;
- PutStr ("OM ") ;
- Marked ; PutCh ("H") ; Normal ;
- PutStr ("CHN") ;
- CrLf ;
- PutStr (" ") ;
- IF codeDest = 1 THEN
- PutStr ("Compile -> COM")
- ELSIF codeDest = 2 THEN
- PutStr ("Compile -> CHN")
- ELSE
- PutStr ("Compile -> Memory")
- END ;
- CrLf ;
- PutStr ("Text: ") ;
- PutCard (Length ()) ;
- PutStr (" Code: ") ;
- PutHex (minCode) ;
- PutStr (" Data: ") ;
- PutHex (minData) ;
- PutStr (" Stack: ") ;
- PutHex (minStack) ;
- CrLf ;
- PutStr ("Command line Params: ") ;
- PutStr (paramLine) ;
- CrLf ;
- Marked ; PutCh ("F") ; Normal ;
- PutStr ("ind run-time error ") ;
- Marked ; PutCh ("Q") ; Normal ;
- PutStr ("uit") ;
- CrLf ;
- CrLf ;
- Marked ; PutCh (">") ; Normal ;
- GetCh (ch) ;
- ch := Upper (ch) ;
- CASE ch OF
- | "M" : codeDest := 0
- | "C" : codeDest := 1
- | "H" : codeDest := 2
- | "O" :
- ClrScr ; GotoXY (1,1) ;
- PutStr ("Min Code Segment (hex): ") ;
- IF ReadLine (s) > 0 THEN minCode := 0 END
- | "D" :
- ClrScr ; GotoXY (1,1) ;
- PutStr ("Min Data Segment (hex): ") ;
- IF ReadLine (s) > 0 THEN minData := 0 END
- | "I" :
- ClrScr ; GotoXY (1,1) ;
- PutStr ("Min Free Dyn Mem / Stack (hex): ") ;
- IF ReadLine (s) > 0 THEN minStack := 0 END
- | "A" :
- ClrScr ; GotoXY (1,1) ;
- PutStr ("Max Free Dyn Mem / Stack (hex): ") ;
- IF ReadLine (s) > 0 THEN maxStack := 0 END
- | "P" :
- ClrScr ; GotoXY (1,1) ;
- PutStr ("Command line Params: ") ;
- IF ReadLine (paramLine) > 0 THEN
- (* keep the parameter string *)
- END
- | "F" :
- ClrScr ; GotoXY (1,1) ;
- PutStr ("Find run-time error address (hex) : ") ;
- IF ReadLine (s) > 0 THEN
- PutStr ("Searching ... (not implemented)") ;
- CrLf ;
- Pause
- END
- | "Q" :
- done := TRUE
- ELSE
- (* ignore *)
- END
- UNTIL done
- END OptionsMenu ;
- (* ------------------------------------------------------------------ *)
- PROCEDURE terminal ;
- VAR ch : CHAR ;
- BEGIN
- Open ;
- drive := "A" ;
- codeDest := 0 ;
- minCode := 0 ; minData := 0 ; minStack := 0 ; maxStack := 0 ;
- StrClear (workName) ;
- StrClear (mainName) ;
- StrClear (paramLine) ;
- Clear ;
- changed := FALSE ;
- LOOP
- DrawMenu ;
- GetCh (ch) ;
- ch := Upper (ch) ;
- CASE ch OF
- | "L" : CmdLogDrive
- | "A" : CmdActDir
- | "W" : CmdWorkFile
- | "M" : CmdMainFile
- | "E" : CmdEditor
- | "C" : CmdCompile
- | "R" : CmdRun
- | "S" :
- IF StrLen (workName) > 0 THEN
- SaveWorkFile ;
- Pause
- END
- | "D" : DirCmd
- | "O" : OptionsMenu
- | "Q" :
- IF changed THEN
- CrLf ;
- IF Confirm ("Work file not saved. Save (Y/N) ?") THEN
- SaveWorkFile
- END
- END ;
- Close ;
- HALT
- ELSE
- (* any other key: redraw the menu, like TP3 *)
- END
- END
- END terminal ;
- BEGIN
- terminal
- END Shell.
|