| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591 |
- Listing:
- 1 (*========================================================
- 2 == JPI-TopSpeed Modula-2 V2 ==
- 3 == demo program: ==
- 4 == ==
- 5 == Terminate and Stay Resident Calculator ==
- 6 == ==
- 7 ========================================================*)
- 8
- 9 (*# data(stack_size=>2000H) *)
- 10 (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *)
- 11 (*# debug(vid=>off) *)
- 12
- 13 MODULE TSRcalc;
- 14 (* ==== *)
- 15
- 16 IMPORT IO,Window,Lib,SYSTEM,Storage;
- 17 IMPORT TSR ;
- 18
- 19 CONST Ix = 30;
- 20 Iy = 10;
- 21 Sx = 22;
- 22 Sy = 2;
- 23
- 24 TYPE LONGSET = SET OF [0..31];
- ***** ^ not supported yet
- 25
- 26 StateType = (DigState,NumState,OptState);
- 27
- 28 ModeType = (DecMode,HexMode,BinMode);
- 29
- 30 ModeInfRec = RECORD
- 31 Name:ARRAY[1..4] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 32 Base:CARDINAL;
- 33 END;
- ***** ^ not supported yet
- 34
- 35 ModeInfArr = ARRAY ModeType OF ModeInfRec;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 36
- 37 CONST ModeInf = ModeInfArr(ModeInfRec("Dec",10),ModeInfRec("Hex",16),ModeInfRec
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 38 ("Bin",2));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 39
- 40 VAR Value,Other,Memory :LONGINT;
- 41 Mode :ModeType;
- ***** ^ not supported yet
- 42 State :StateType;
- ***** ^ not supported yet
- 43 Q,C,Opt :CHAR;
- 44 W :Window.WinType;
- ***** ^ not supported yet
- 45 X,Y :CARDINAL;
- 46
- 47
- 48 CONST KeyL = CHR(128+75);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 49 KeyR = CHR(128+77);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 50 KeyU = CHR(128+72);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 51 KeyD = CHR(128+80);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 52 Key5 = CHR(128+63);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 53 Key10 = CHR(128+68);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 54
- 55 PROCEDURE BiosGetKey():CHAR;
- 56 (* ========== *)
- 57
- 58 VAR R:SYSTEM.Registers;
- ***** ^ not supported yet
- 59
- 60 BEGIN
- 61 R.AH := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 62 Lib.Intr(R,016H);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 63 IF R.AL<>0 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 64 RETURN CHR(R.AL);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 65 ELSE
- 66 RETURN CHR(128+R.AH);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 67 END;
- 68 END BiosGetKey;
- ***** ^ not supported yet
- 69
- 70 PROCEDURE UpdateDisplay;
- 71 (* ============== *)
- 72
- 73 CONST Width = 16;
- 74
- 75 VAR I:CARDINAL;
- 76
- 77 BEGIN
- 78 Window.GotoXY(4,1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 79 CASE Mode OF
- ***** ^ not supported yet
- 80
- 81 | DecMode:IO.WrLngInt(Value,Width);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 82 | HexMode:IO.WrLngHex(Value,Width);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 83 | BinMode:FOR I := Width-1 TO 0 BY -1 DO
- ***** ^ not supported yet
- 84 IO.WrChar(CHR(ORD('0')+ORD(I IN LONGSET(Value))));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 85 END;
- 86
- 87 END;
- 88 Window.GotoXY(4,2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 89 IO.WrStr(ModeInf[Mode].Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 90 IO.WrStr(" ");
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 91 IF Memory<>0 THEN
- 92 IO.WrStr("M");
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 93 ELSE
- 94 IO.WrStr(" ");
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 95 END;
- 96 END UpdateDisplay;
- ***** ^ not supported yet
- 97
- 98 PROCEDURE Crash(L:CARDINAL);
- 99 (* ===== *)
- 100
- 101
- 102 VAR I:SHORTCARD;
- 103 J:CARDINAL;
- 104 P,Q:BITSET;
- ***** ^ undeclared identifier
- 105
- 106 BEGIN
- 107 Q := BITSET(SYSTEM.In(061H));
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 108 P := Q*{2..7};
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 109 J := L;
- 110 WHILE J>0 DO
- 111 SYSTEM.Out(061H,SHORTCARD(P));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 112 FOR I := 0 TO SHORTCARD([400H:J]^) DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- 113 P := P/{1};
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 114 END;
- 115 DEC(J);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 116 END;
- 117 SYSTEM.Out(061H,SHORTCARD(Q));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 118 L := L DIV 100;
- 119 IF (X>=L) AND (Y>=L) THEN
- 120 FOR J := 1 TO L DO
- 121 DEC(X);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 122 DEC(Y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 123 Window.Change(W,X,Y,X+Sx+J+J,Y+Sy+J+J);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 124 END;
- 125 FOR J := L TO 1 BY -1 DO
- 126 INC(X);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 127 INC(Y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 128 Window.Change(W,X,Y,X+Sx+J+J-1,Y+Sy+J+J-1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 129 END;
- 130 END
- 131 END Crash;
- ***** ^ not supported yet
- 132
- 133
- 134 PROCEDURE RunCalc;
- 135 (* ======= *)
- 136
- 137 VAR I,F:CARDINAL;
- 138 R:SYSTEM.Registers;
- ***** ^ not supported yet
- 139
- 140 BEGIN
- 141 Window.PutOnTop(W);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 142 Window.Use(W);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 143 LOOP
- 144 CASE C OF
- 145 | 'c':Value := 0;
- 146 Other := 0;
- 147 Opt := '=';
- 148 | '0'..'9','A'..'F',
- 149 Key5..Key10:IF C<='9' THEN
- 150 DEC(C,ORD('0'));
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 151 ELSIF (C>='A')AND(C<='F') THEN
- 152 DEC(C,ORD('A'));
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 153 INC(C,10);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 154 ELSE
- 155 DEC(C,ORD(Key5));
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 156 INC(C,10);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 157 END;
- 158 IF ORD(C)<ModeInf[Mode].Base THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 159 IF State<>DigState THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 160 Value := 0;
- 161 END;
- 162 State := DigState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 163 IF Value<=MAX(LONGINT) DIV LONGINT(ModeInf[Mode].Base)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 164 THEN
- 165 Value := Value*LONGINT(ModeInf[Mode].Base)+LONGINT(ORD
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 166 (C));
- ***** ^ not supported yet
- 167 ELSE
- 168 Crash(50);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 169 END;
- 170 ELSE
- 171 Crash(100);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 172 END;
- 173 | 10C:IF State = DigState THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 174 Value := Value DIV LONGINT(ModeInf[Mode].Base);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 175 END;
- 176 | 'e':Value := 0;
- 177 State := NumState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 178
- 179 | '+','-','*','/','a','o','x','=',CHR(13),'X','O':
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 180 IF State<>OptState THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 181 CASE Opt OF
- 182
- 183 | '+':Other := Other+Value;
- 184 | '-':Other := Other-Value;
- 185 | '*':Other := Other*Value;
- 186 | '/':
- 187 IF Value = 0 THEN Other := MAX(LONGINT)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 188 ELSE Other := Other DIV Value;
- 189 END;
- 190 | 'a':Other := LONGINT(LONGSET(Other)*LONGSET(Value));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 191 | 'O',
- 192 'o':Other := LONGINT(LONGSET(Other)+LONGSET(Value));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 193 | 'X',
- 194 'x':Other := LONGINT(LONGSET(Other)/LONGSET(Value));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 195 | CHR(13),
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 196 '=':Other := Value;
- 197
- 198 END;
- 199 Value := Other;
- 200 State := OptState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 201 END;
- 202 Opt := C;
- 203 | 'd':Mode := DecMode;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 204 State := NumState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 205 | 'H',
- 206 'h':Mode := HexMode;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 207 State := NumState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 208 | 'b':Mode := BinMode;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 209 State := NumState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 210 | 'M',
- 211 'm':C := BiosGetKey();
- ***** ^ not supported yet
- ***** ^ not supported yet
- 212 CASE CAP(C) OF
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 213
- 214 | '+':Memory := Memory+Value;
- 215 | '-':Memory := Memory-Value;
- 216 | '*':Memory := Memory*Value;
- 217 | '/':Memory := Memory DIV Value;
- 218 | 'R':Value := Memory;
- 219 State := NumState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 220 | 'C':Memory := 0;
- 221 | '=':Memory := Value;
- 222
- 223 END;
- 224 State := NumState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 225 | KeyL,KeyR,
- 226 KeyU,KeyD:
- 227
- 228 IF (C = KeyL) AND (X>0) THEN DEC(X);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 229 ELSIF (C = KeyR) AND (X+Sx<78) THEN INC(X);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 230 ELSIF (C = KeyU) AND (Y>0) THEN DEC(Y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 231 ELSIF (C = KeyD) AND (Y+Sy<23) THEN INC(Y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 232 ELSE
- 233 F := 2000;
- 234 WHILE (X<>Ix) OR (Y<>Iy) DO
- 235 FOR I := 1 TO 10 DO
- 236 Lib.Sound(F);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 237 Lib.Delay(5);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 238 DEC(F,F DIV 50);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 239 END;
- 240 IF X>Ix THEN DEC(X); END;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 241 IF X<Ix THEN INC(X); END;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 242 IF Y>Iy THEN DEC(Y); END;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 243 IF Y<Iy THEN INC(Y); END;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 244 Window.Change(W,X,Y,X+Sx+1,Y+Sy+1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 245 END;
- 246 Lib.NoSound;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 247 Crash(800);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 248 C := ' ';
- 249 EXIT;
- 250 END;
- 251 Window.Change(W,X,Y,X+Sx+1,Y+Sy+1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 252 | ' ':;
- 253 | CHR(27):
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 254 C := ' ';
- 255 EXIT;
- 256 | CHR(45+128): (* ALT X *)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 257 TSR.DeInstall ;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 258 EXIT ;
- 259 |
- 260 ELSE
- 261 Crash(200);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 262 END;
- 263 UpdateDisplay;
- ***** ^ not supported yet
- 264 C := BiosGetKey();
- ***** ^ not supported yet
- ***** ^ not supported yet
- 265 END;
- 266 Window.Hide(W);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 267 END RunCalc;
- ***** ^ not supported yet
- 268
- 269
- 270
- 271 BEGIN
- 272 IO.WrStr("Installing JPI-CALC,"); IO.WrLn;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 273 IO.WrStr("AltZ to activate."); IO.WrLn;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 274 X := Ix;
- 275 Y := Iy;
- 276 W := Window.Open(Window.WinDef(Ix,Iy,Ix+Sx+1,Iy+Sy+1,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 277 Window.White,Window.Black,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 278 FALSE,FALSE,TRUE,TRUE,
- 279 Window.DoubleFrame,Window.Black,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 280 Window.Green));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 281 Window.SetTitle(W," JPI-CALC ",Window.CenterUpperTitle);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 282 Memory := 0;
- 283 Mode := DecMode;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 284 State := NumState;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 285 C := 'c';
- 286 TSR.Install(RunCalc,TSR.KBFlagSet{TSR.Alt},44,400H) ; (* ALT Z *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 287 Window.Clear ;
- 288 IO.WrStr("JPI-CALC Deinstalled.");
- 289 IO.WrLn;
- 290 END TSRcalc.
- 291 (*======================================================*)
- 292
- 293 errors
|