Skip to content

Instantly share code, notes, and snippets.

@pakLebah
Last active Feb 1, 2020
Embed
What would you like to do?
Fancy input for console program.
program fancyInput;
(*****************************************************************************
This program demonstrates fancy input mechanism for console application by
simply using CRT unit. For example selecting an item from a drop down menu,
length-limited phone number input, and yes/no input. Hopefully, new Pascal
beginners will learn something from this sample program. Thank you. :)
//! WARNING! This program requires FPC v3.2+ with compiler option -S2chij-
Author: @pakLebah a.k.a Mr. Bee
Update: January, 2020
*****************************************************************************)
uses CRT;
type
ArrayOfString = array of string;
ArrayOfChar = array of char;
// text positioning shortcut
procedure writeAt(const x, y: integer; const text: string);
begin
gotoXY(x, y);
write(text);
end;
// text coloring shortcut
procedure textColors(const fore, back: integer; const text: string);
begin
textColor(fore);
textBackground(back);
write(text);
end;
// print menu with selected item
procedure printMenu(const x, y, selected: integer; const items: ArrayOfString);
var
i: integer;
begin
for i := 0 to length(items)-1 do
begin
gotoXY(x, y+i);
if i = selected then
textColors(black, lightGray, '» '+items[i]+' «')
else
textColors(lightGray, darkgray, ' '+items[i]+' ');
end;
end;
// clear printed menu items
procedure clearMenu(const x, y, count: integer);
var
i: integer;
begin
for i := 1 to count do
begin
gotoXY(x, y+i-1);
clrEOL;
end;
gotoXY(x, y);
end;
// read input using menu selection
function readMenu(const items: ArrayOfString; const isRotate: boolean): integer;
var
key: char = #0;
i, line, sel: integer;
count, row, col: integer;
begin
sel := 0;
col := whereX;
row := whereY;
count := length(items);
highVideo;
// make sure there is enough lines for menu items
line := screenHeight - row;
if line <= count then
begin
for i := 1 to count do writeln;
row := row - (count-line);
end;
printMenu(col, row, sel, items);
repeat
if keyPressed then
begin
key := readKey;
if key = #0 then // control keys
begin
key := readKey;
case key of
#72, #75: sel -= 1; // up+left arrow
#77, #80: sel += 1; // down+right arrow
end;
// limit cursor movement
if sel < 0 then
if isRotate then sel := count-1 else sel := 0;
if sel > count-1 then
if isRotate then sel := 0 else sel := count-1;
end
else // ASCII keys
begin
case key of
#13 : {nothing}; // enter to select item
#27 : sel := -1; // esc to cancel menu
end;
end;
printMenu(col, row, sel, items);
end;
until (key = #13) or (key = #27);
// clear menu and print selection
normVideo;
clearMenu(col, row, count);
if sel >= 0 then writeln(items[sel]) else writeln('');
result := sel;
end;
// query using menu selection
function askMenu(const query: string; const items: ArrayOfString): integer;
begin
write(query); ClrEol;
result := readMenu(items, length(items) >= 4);
end;
// query using selected answer
function askBool(const query: string; const answers: ArrayOfChar): boolean;
var
key: char;
valid: boolean = false;
i, answer, count: integer;
begin
write(query);
count := length(answers);
repeat
if keyPressed then
begin
key := readKey;
// validate input against answers
for i := 0 to count-1 do
begin
valid := (upCase(key) = upCase(answers[i])) or (key = #27);
if valid and (key <> #27) then
begin
answer := i+1;
write(key);
break;
end;
end;
// array item must be even, first half for true values
result := (answer <= count div 2) and (key <> #27);
end;
until valid or (key = #27);
writeln;
end;
// query accepting numbers only
function askNumber(const query: string; const count: integer): string;
var
key: char;
valid: boolean = false;
i, cursor, col: integer;
begin
// just skip invalid query
if count <= 0 then writeln(query) else write(query);
if count <= 0 then exit;
// print length limit
col := whereX;
if count > 0 then // show input length limit
for i := 1 to count do write('_');
gotoXY(col, whereY);
cursor := 1;
result := '';
repeat
if keyPressed then
begin
key := readKey;
// validate digit input
if cursor = 1 then
valid := (key in ['0'..'9','+','-',#13,#27]) and (cursor <= count+1)
else
valid := (key in ['0'..'9',#8,#13,#27]) and (cursor <= count+1);
// print digit only
if valid and not (key in [#8,#13,#27]) then
begin
cursor += 1;
if (count > 0) and (cursor > count) then cursor := count+1;
// accept input only within limit
if cursor <= count+1 then
begin
writeAt(col+cursor-2, whereY, key);
result += key;
// reject input beyond limit
if cursor = count+1 then
begin
result[count] := key;
result := copy(result, 1, cursor-1);
end;
end;
end;
// cancel input (escape)
if valid and (key = #27) then
begin
gotoXY(col, whereY);
for i := 1 to count do write('_');
result := '';
end;
// erase last char (backspace)
if valid and (key = #8) and (cursor > 1) then
begin
cursor -= 1;
result := copy(result, 1, cursor-1); // remove last char
writeAt(col+cursor, whereY, key+'_');
gotoXY(col+cursor-1, whereY);
end;
end;
until (key = #13) or (key = #27);
writeln;
end;
// query for simple unlimited text
function askText(const query: string): string;
begin
write(query); ClrEOL;
readln(result);
end;
(***** MAIN PROGRAM *****)
var
// this open array declaration requires FPC v3.2+
teachers: ArrayOfString = ('Bambang, S.Pd','Ningsih, A.Md','Drs. Pujiyono');
studies : ArrayOfString = ('Fisika ','Biologi','Sosial ','Bahasa ');
grades : ArrayOfString = ('Kelas 7','Kelas 8','Kelas 9');
genders : ArrayOfString = ('Laki-laki','Perempuan');
var
gender, grade, study, teacher: integer;
name, address, phone: string;
again: boolean = false;
begin
repeat
// get input
writeln('MASUKKAN DATA BERIKUT');
writeln('–––––––––––––––––––––');
name := askText ('Nama lengkap : ');
gender := askMenu ('Jenis kelamin : ',genders);
address := askText ('Alamat rumah : ');
phone := askNumber('Nomor ponsel : ',15);
grade := askMenu ('Tingkat kelas : ',grades);
study := askMenu ('Jurusan studi : ',studies);
teacher := askMenu ('Nama wali kelas : ',teachers);
writeln;
// confirm input
writeln('Data telah diterima:');
writeln('Nama lengkap = ',name);
if gender >= 0 then writeln('Jenis kelamin = ',genders[gender]);
writeln('Alamat rumah = ',address);
writeln('Nomor ponsel = ',phone);
if grade >= 0 then writeln('Tingkat kelas = ',grades[grade]);
if study >= 0 then writeln('Jurusan studi = ',studies[study]);
if teacher >= 0 then writeln('Nama wali kelas = ',teachers[teacher]);
writeln;
// repeat input
again := askBool('Mengisi data lagi? (Y/T) ',['Y','T']);
if again then writeln else writeln('Terima kasih.');
until not again;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment