RAMSES
MacMETH DM AuxLib SciLib EasyMW MW ISIS RMS Shell RMS Extras RASS
Example: Random
Screen Dump
Source Code
MODULE Random; (* A.Fischlin 30/6/86, 8/4/99 *)
FROM DMLanguage IMPORT SetLanguage, Language;
FROM DMMenus IMPORT Menu, Command, AccessStatus, Marking,
InstallAbout,
InstallMenu, InstallCommand, InstallAliasChar,
Separator, InstallSeparator,
InstallQuitCommand,
DisableCommand, EnableCommand,
ChangeCommandText;
FROM DMWindows IMPORT Window, notExistingWindow,
WindowKind, ScrollBars,
CloseAttr, ZoomAttr, WFFixPoint,
WindowFrame,
CreateWindow,
AutoRestoreProc, DummyRestoreProc,
GetWindowFrame, WindowExists,
RemoveWindow;
FROM DMWindIO IMPORT SelectForOutput,
ScaleUC, UCDot, UCFrame,
SetPen, CellHeight, CellWidth,
EraseUCFrameContent,
BackgroundWidth, BackgroundHeight,
SetPos, WriteReal, Write, WriteString, WriteLn,
EraseContent;
FROM DMMaster IMPORT MouseHandlers, AddMouseHandler,
AddSetupProc, RunDialogMachine,
DialogMachineTask;
FROM DMEntryForms IMPORT FormFrame, WriteLabel, DefltUse,
CardField,
RadioButtonID, DefineRadioButtonSet, RadioButton,
UseEntryForm;
FROM DMAlerts IMPORT WriteMessage, ShowAlert;
FROM Randoms IMPORT Seed, GetZ, U, SetMultiplier;
(************************************)
(*##### About this program #####*)
(************************************)
PROCEDURE AboutProc;
BEGIN
SetPos(2,1);
WriteString(" RANDOM"); WriteLn;
WriteString(" Die Erzeugung von Pseudozufallszahlen"); WriteLn;
WriteString(" (c) Andreas Fischlin, ETHZ"); WriteLn;
WriteString(" 08/April/1999"); WriteLn; WriteLn;
WriteString(" This program may be freely copied as long"); WriteLn;
WriteString(" as it is not used for commercial purposes"); WriteLn;
END AboutProc;
(******************************************)
(*##### DM referencing variables #####*)
(******************************************)
VAR
myMenu: Menu;
makeWindows, randGens, oneDot, setPars, seed, clear, quit: Command;
graphW: Window; wf: WindowFrame; dataW: Window;
(***************************************************************)
(*##### program states and state transition procedure #####*)
(***************************************************************)
TYPE
MachineStates = (noWind, withWindsNoRandGen, withWindsAndRandGen);
VAR
curDMState: MachineStates;
PROCEDURE SetDMState(s: MachineStates);
BEGIN
CASE s OF
noWind: IF WindowExists(graphW) THEN RemoveWindow(graphW) END;
IF WindowExists(dataW) THEN RemoveWindow(dataW) END;
EnableCommand(myMenu, makeWindows);
DisableCommand(myMenu, randGens);
DisableCommand(myMenu, oneDot);
EnableCommand(myMenu, setPars);
EnableCommand(myMenu, seed);
DisableCommand(myMenu, clear);
| withWindsNoRandGen:
DisableCommand(myMenu, makeWindows);
EnableCommand(myMenu, randGens);
EnableCommand(myMenu, oneDot);
ChangeCommandText(myMenu,randGens,
"Starte kont. Zufallszahlengeneration");
EnableCommand(myMenu, setPars);
EnableCommand(myMenu, seed);
EnableCommand(myMenu, clear);
| withWindsAndRandGen:
DisableCommand(myMenu, makeWindows);
EnableCommand(myMenu, randGens);
ChangeCommandText(myMenu,randGens,
"Stoppe kont. Zufallszahlengeneration");
DisableCommand(myMenu, oneDot);
DisableCommand(myMenu, setPars);
DisableCommand(myMenu, seed);
EnableCommand(myMenu, clear);
(* SelectForOutput(graphW);
EraseUCFrameContent; *)
END(*CASE*);
curDMState:= s;
END SetDMState;
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
MODULE AdHocGenerator; (**************************************************)
EXPORT AdHocU, SetParams, GetParams, AdHocSeed, adHocSeed0, AdHocGetZ;
CONST adHocSeed0 = 30000;
VAR z: CARDINAL; A,M: CARDINAL;
PROCEDURE SetParams(multiplier,modulus: CARDINAL);
BEGIN
A:= multiplier; M:= modulus;
END SetParams;
PROCEDURE GetParams(VAR multiplier,modulus: CARDINAL);
BEGIN
multiplier:= A; modulus:= M;
END GetParams;
PROCEDURE AdHocU(): REAL;
BEGIN
z:= A*z MOD M;
RETURN FLOAT(z)/FLOAT(M)
END AdHocU;
PROCEDURE AdHocSeed(z0: CARDINAL);
BEGIN
z:= z0;
END AdHocSeed;
PROCEDURE AdHocGetZ(VAR zz: LONGINT);
BEGIN
zz:= z;
END AdHocGetZ;
BEGIN
AdHocSeed(adHocSeed0); SetParams(7,31);
END AdHocGenerator; (*****************************************************)
(**********************************************************)
(*##### Global objects and some ouput procedures #####*)
(**********************************************************)
CONST
seed0 = 1D;
VAR
x,y: REAL; z1,z2: LONGINT;
curU: PROCEDURE (): REAL;
curGetZ: PROCEDURE (VAR LONGINT);
PROCEDURE ResetGlobVars;
BEGIN
x:= 0.0; y:= 0.0; curGetZ(z1); z2:= 0D;
END ResetGlobVars;
PROCEDURE ResetRandGen;
BEGIN
Seed(seed0); AdHocSeed(adHocSeed0);
ResetGlobVars;
END ResetRandGen;
PROCEDURE Clear(u: Window);
BEGIN
SelectForOutput(u);
EraseContent;
END Clear;
PROCEDURE ScaleGraph;
CONST m = 35;
VAR wf: WindowFrame; lm,bm: CARDINAL; lmlab,bmlab: INTEGER;
BEGIN
GetWindowFrame(graphW,wf);
wf.x:= m; wf.y:= m;
wf.w:= wf.w - 7*m DIV 4; wf.h:= wf.h - 7*m DIV 4;
SelectForOutput(graphW);
ScaleUC(wf,0.0,1.0,0.0,1.0);
UCFrame;
GetWindowFrame(graphW,wf);
bm:= m - CellHeight(); bmlab:= bm; bmlab:= bmlab-CellHeight() DIV 3;
SetPen(m,bm); Write("0");
SetPen(wf.w-3*m DIV 4-CellWidth()*2 DIV 3,bm); Write("1");
SetPen((wf.w) DIV 2,bmlab); Write("X");
lm:= m-(3*CellWidth() DIV 2); lmlab:= lm; lmlab:= lmlab-CellWidth() DIV 2;
SetPen(lm,m); Write("0");
SetPen(lm,wf.h-3*m DIV 4-CellHeight()*2 DIV 3); Write("1");
SetPen(lmlab,(wf.h) DIV 2); Write("Y");
END ScaleGraph;
PROCEDURE DocDotData(u: Window);
CONST
le = 8; dig = 5;
PROCEDURE WriteLongInt(x: LONGINT; n: CARDINAL);
VAR i,c: CARDINAL; x0: LONGCARD;
a: ARRAY [0..11] OF CHAR;
BEGIN (*WriteLongInt*)
i := 0; x0 := ABS(x);
REPEAT
c := x0 MOD 10D;
a[i] := CHAR(ORD("0") + c);
x0 := x0 DIV 10D; INC(i)
UNTIL x0 = 0D;
IF x < 0D THEN a[i] := "-"; INC(i) END ;
WHILE n > i DO
DEC(n); Write(" ")
END ;
REPEAT DEC(i); Write(a[i]) UNTIL i = 0
END WriteLongInt;
BEGIN (*DocDotData*)
SelectForOutput(u);
EraseContent;
SetPos(1,6); WriteString("Z(k)");
SetPos(2,1);
WriteLongInt(z1,14);
SetPos(3,1);
WriteLongInt(z2,14);
SetPos(1,19); WriteString("U(k)");
SetPos(2,15);
WriteString("X: "); WriteReal(x,le,dig);
SetPos(3,15);
WriteString("Y: "); WriteReal(y,le,dig);
END DocDotData;
(*******************************)
(*##### Menu commands #####*)
(*******************************)
(*--------------------------------*)
(*===== "Oeffne Fenster" =====*)
(*--------------------------------*)
PROCEDURE MakeWindows;
BEGIN
ResetGlobVars;
wf.x:= 25; wf.y:= 25; wf.w:= 250; wf.h:= 250;
CreateWindow(graphW,
GrowOrShrinkOrDrag,WithoutScrollBars,
WithCloseBox,WithoutZoomBox,bottomLeft,wf,
'Pseudozufallszahlen',
AutoRestoreProc);
ScaleGraph;
wf.x:= wf.x + wf.w + 25;
wf.y:= wf.y + wf.h DIV 2;
wf.w:= 190; wf.h:= 3*CellHeight();
CreateWindow(dataW,
FixedSize,WithoutScrollBars,
WithCloseBox,WithoutZoomBox,bottomLeft,wf,
'Letzter Punkt',
DocDotData);
SetDMState(withWindsNoRandGen);
END MakeWindows;
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(*------------------------------------------------------*)
(*===== "Starte kont. Zufallszahlengeneration" =====*)
(*------------------------------------------------------*)
PROCEDURE GenADot; FORWARD;
PROCEDURE ToggleRandGen;
PROCEDURE ProdRandGens;
BEGIN (*ProdRandGens*)
REPEAT
GenADot;
DialogMachineTask;
UNTIL curDMState <> withWindsAndRandGen
END ProdRandGens;
BEGIN (*ToggleRandGen*)
IF curDMState = withWindsNoRandGen THEN
SetDMState(withWindsAndRandGen);
ProdRandGens;
ELSIF curDMState = withWindsAndRandGen THEN
SetDMState(withWindsNoRandGen);
END(*IF*);
END ToggleRandGen;
(*--------------------------------------------*)
(*===== "Erzeuge zwei Zufallszahlen" =====*)
(*--------------------------------------------*)
PROCEDURE GenADot;
BEGIN
x:= curU(); curGetZ(z1); y:= curU(); curGetZ(z2);
SelectForOutput(graphW);
UCDot(x,y);
DocDotData(dataW);
END GenADot;
(*-------------------------------------------*)
(*===== "Loesche und setze zurueck" =====*)
(*-------------------------------------------*)
PROCEDURE ClearResetAndScale;
VAR wf: WindowFrame;
BEGIN
IF curDMState = withWindsAndRandGen THEN
SetDMState(withWindsNoRandGen);
END(*IF*);
Clear(graphW);
ScaleGraph;
Clear(dataW);
ResetRandGen;
DocDotData(dataW);
END ClearResetAndScale;
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(*-----------------------------------------------*)
(*===== "Waehle Zufallszahlengenerator" =====*)
(*-----------------------------------------------*)
VAR
usePreDefGen: BOOLEAN;
PROCEDURE SetGenerator;
VAR bf: FormFrame; ok: BOOLEAN; A,M: CARDINAL;
genSet,adHocGen,preDefGen: RadioButtonID;
BEGIN
WriteLabel(2,5,"Linearer Kongruenter Zufallszahlengenerator:");
WriteLabel(3,5," z(k+1) = A * z(k) MOD M");
DefineRadioButtonSet(genSet);
WriteLabel(5,6,"Vordefinierter multiplikativer Generator der Form");
RadioButton(preDefGen,6,6,"z(k+1) = 950706376 * z(k) MOD (2**31 - 1)");
WriteLabel(8,6,"Definierbarer Generator:");
RadioButton(adHocGen,9,6,"z(k+1) = A * z(k) MOD M");
IF usePreDefGen THEN genSet:= preDefGen ELSE genSet:= adHocGen END;
GetParams(A,M);
WriteLabel(10,9,"A = ");
CardField(10,13,7,A,useAsDeflt,0,MAX(CARDINAL));
WriteLabel(10,25,"M = ");
CardField(10,29,7,M,useAsDeflt,0,MAX(CARDINAL));
bf.x:= 0; bf.y:= -1 (*display dialog window in middle of screen*);
bf.lines:= 13; bf.columns:= 50;
UseEntryForm(bf,ok);
IF ok THEN
IF genSet = preDefGen THEN
usePreDefGen:= TRUE; curU:= U; curGetZ:= GetZ
ELSE
usePreDefGen:= FALSE; curU:= AdHocU; curGetZ:= AdHocGetZ;
SetParams(A,M);
END;
IF curDMState <> noWind THEN
ClearResetAndScale
ELSE
ResetRandGen;
END(*IF*);
END(*IF*);
END SetGenerator;
(*------------------------------*)
(*===== "Setze 'Seed'" =====*)
(*------------------------------*)
PROCEDURE SetSeed;
VAR bf: FormFrame; ok: BOOLEAN; seed: CARDINAL;
BEGIN
WriteLabel(2,10,"seed = ");
IF usePreDefGen THEN seed:= seed0 ELSE seed:= adHocSeed0 END;
CardField(2,18,7,seed,useAsDeflt,1,MAX(CARDINAL));
bf.x:= 0; bf.y:= -1 (*display dialog window in middle of screen*);
bf.lines:= 6; bf.columns:= 40;
UseEntryForm(bf,ok);
IF ok THEN
IF usePreDefGen THEN Seed(seed) ELSE AdHocSeed(seed) END;
ResetGlobVars;
IF curDMState <> noWind THEN
Clear(dataW);
DocDotData(dataW);
END(*IF*);
END(*IF*);
END SetSeed;
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(*----------------------------------*)
(*===== "Programm beenden" =====*)
(*----------------------------------*)
PROCEDURE Quitting(VAR reallyQuit: BOOLEAN);
BEGIN
reallyQuit:= TRUE;
SetDMState(noWind)
END Quitting;
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(*******************************)
(*##### MouseHandlers #####*)
(*******************************)
PROCEDURE EnableMenuIfWindowCloses(u: Window);
BEGIN
SetDMState(noWind);
END EnableMenuIfWindowCloses;
PROCEDURE RescaleIfWindowIsRedefined(u: Window);
BEGIN
ClearResetAndScale;
END RescaleIfWindowIsRedefined;
(******************************************************)
(*##### Initialization when DM starts to run #####*)
(******************************************************)
PROCEDURE SettingUp;
BEGIN
curU:= U; curGetZ:= GetZ;
usePreDefGen:= TRUE; ResetRandGen;
SetMultiplier(397204094D);
(* the 5 best in reverse order *)
SetMultiplier(1343714438D);
SetMultiplier(62089911D);
SetMultiplier(1226874159D);
SetMultiplier(742938285D);
(* the best *)
SetMultiplier(950706376D);
(* one to test/use *)
SetMultiplier(950706376D);
graphW:= notExistingWindow;
dataW:= notExistingWindow;
SetDMState(noWind);
END SettingUp;
(***********************************************************)
(*##### Initialization of DM before it is running #####*)
(***********************************************************)
PROCEDURE DMInitialization;
CONST highPrio = 0;
BEGIN
SetLanguage(German);
InstallAbout("Ueber | RANDOM ...",300,140,AboutProc);
InstallMenu(myMenu,'Kontrolle',enabled);
InstallCommand(myMenu, makeWindows,"Oeffne Fenster", MakeWindows,
enabled, unchecked);
InstallSeparator(myMenu,line);
InstallCommand(myMenu,randGens,"Starte kont. Zufallszahlengeneration",
ToggleRandGen,disabled,unchecked);
InstallAliasChar(myMenu,randGens,"S");
InstallCommand(myMenu,oneDot,"Erzeuge zwei Zufallszahlen",
GenADot,disabled,unchecked);
InstallAliasChar(myMenu,oneDot,"p");
InstallCommand(myMenu,clear,"Loesche und setze zurueck",
ClearResetAndScale,disabled,unchecked);
InstallSeparator(myMenu,line);
InstallCommand(myMenu,setPars,"Waehle Zufallszahlengenerator",
SetGenerator,disabled,unchecked);
InstallCommand(myMenu,seed,"Setze 'Seed'",
SetSeed,disabled,unchecked);
InstallQuitCommand("Programm beenden",Quitting,0C);
AddSetupProc(SettingUp,highPrio);
AddMouseHandler(CloseWindow,EnableMenuIfWindowCloses,highPrio);
AddMouseHandler(RedefWindow,RescaleIfWindowIsRedefined,highPrio);
END DMInitialization;
BEGIN
DMInitialization;
RunDialogMachine
END Random.