home *** CD-ROM | disk | FTP | other *** search
- {$R-} {Range checking off}
- {$B+} {Boolean complete evaluation on}
- {$S+} {Stack checking on}
- {$I+} {I/O checking on}
- {$N-} {No numeric coprocessor}
- {$M 65500,16384,655360} {Turbo 3 default stack and heap}
-
-
- PROGRAM Stackdemo;
-
-
- uses scl;
-
- PROCEDURE Scl_Defaults;
- BEGIN;
- Beep_Time:=2; {Beep shorter}
- Auto_Help_Set:=FALSE; {No autohelp in this program}
- END;
-
- FUNCTION Up:BOOLEAN;
- BEGIN;
- Up:=FALSE;
- IF User_Function THEN {user function key pressed}
- BEGIN;
- IF (Active_Field = 1) AND {'Up' field}
- (Char_Code = Code_Return) THEN { wants to select field}
- BEGIN;
- Up:=TRUE;
- Char_Code:=Code_Noop; { SCL should not do anything}
- END; { with this input character,}
- END; { i.e not mark the field as }
- END; { selected}
-
-
- PROCEDURE Do_Format(This_Name:String10;This_X,This_Y:INTEGER);
- VAR
- N,
- Next_Name:String10;
- Next_X,
- Next_Y :INTEGER;
- BEGIN;
- Select_Format(This_Name); {load it from disk}
- Display_Format(This_X,This_Y); {display it }
- Next_X:=This_X+2; {increase displacements}
- Next_Y:=This_Y+1; {for the next format to be loaded}
- REPEAT
- Handle_Format; {handle this format}
- IF Up THEN {user wants to go up}
- BEGIN;
- N:=Capital(This_Name); {capital letters}
- IF N = 'ONE' THEN Next_Name:='Two' ELSE {Which}
- IF N = 'TWO' THEN Next_Name:='Three' ELSE {format}
- IF N = 'THREE' THEN Next_Name:='four' ELSE {is}
- IF N = 'FOUR' THEN Next_Name:='Five' ELSE {the}
- IF N = 'FIVE' THEN Next_Name:='Six' ELSE {next}
- IF N = 'SIX' THEN Next_Name:='Seven' ELSE {one}
- IF N = 'SEVEN' THEN Next_Name:='Eight' ELSE { ? }
- IF N = 'EIGHT' THEN Next_Name:='Nine' ELSE
- IF N = 'NINE' THEN Next_Name:='Ten';
- Do_Format(Next_Name,Next_X,Next_Y); {Recursive}
- END; {call with new name and displacements}
- UNTIL Format_Done; {this format is finished.}
- END; {of Do_Format}
-
- BEGIN; {of main}
- Select_Format_File('Sample3'); {initialize SCL and load}
- {format file 'Sample2'}
- Scl_Defaults; {change some SCL defaults}
- Do_Format('one',0,0); {display&handle format 'one'}
- Close_Formats; {terminate SCL}
- END. {of main}