431 lines
16 KiB
Rexx
Executable File
431 lines
16 KiB
Rexx
Executable File
/*----------------------------------------------------------------------------*/
|
|
/* */
|
|
/* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */
|
|
/* Copyright (c) 2005-2014 Rexx Language Association. All rights reserved. */
|
|
/* */
|
|
/* This program and the accompanying materials are made available under */
|
|
/* the terms of the Common Public License v1.0 which accompanies this */
|
|
/* distribution. A copy is also available at the following address: */
|
|
/* https://www.oorexx.org/license.html */
|
|
/* */
|
|
/* Redistribution and use in source and binary forms, with or */
|
|
/* without modification, are permitted provided that the following */
|
|
/* conditions are met: */
|
|
/* */
|
|
/* Redistributions of source code must retain the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer. */
|
|
/* Redistributions in binary form must reproduce the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer in */
|
|
/* the documentation and/or other materials provided with the distribution. */
|
|
/* */
|
|
/* Neither the name of Rexx Language Association nor the names */
|
|
/* of its contributors may be used to endorse or promote products */
|
|
/* derived from this software without specific prior written permission. */
|
|
/* */
|
|
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
|
|
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */
|
|
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */
|
|
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */
|
|
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */
|
|
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */
|
|
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */
|
|
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */
|
|
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */
|
|
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */
|
|
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
|
|
/* */
|
|
/*----------------------------------------------------------------------------*/
|
|
|
|
/**
|
|
* oophil.rex An ooDialog demonstration of the Philosopher's Forks
|
|
*/
|
|
|
|
myDir = locate()
|
|
|
|
/*---------------------- run default parameters ----------------------*/
|
|
|
|
parms.107 = 80 /* sleeping time 80 * 100 ms = 8 sec */
|
|
parms.108 = 50 /* eating time 50 * 100 ms = 5 sec */
|
|
parms.109 = 3 /* 3 repetitions */
|
|
parms.104 = 0 /* radio button left fork first off */
|
|
parms.105 = 0 /* right fork first off */
|
|
parms.106 = 1 /* any fork first on */
|
|
|
|
/*---------------------- dialogs & resources -------------------------*/
|
|
|
|
v.anidialogID = 100 /* animation dialog graphical */
|
|
v.anidialog = myDir'rc\oophil2.rc'
|
|
v.setdialogID = 101 /* setup dialog for parameters */
|
|
v.setdialog = myDir'rc\oophil1.rc'
|
|
|
|
/*---------------------- animation dialog IDs ------------------------*/
|
|
|
|
v.idp = 100 /* phil 101-105 */
|
|
v.idf = 105 /* fork 106-110 */
|
|
v.idhr = 111 /* hand-r 121,131,141,151,161 */
|
|
v.idhl = 112 /* hand-l 122,132,142,152,162 */
|
|
v.idcake = 120 /* cake */
|
|
v.idpc = 110 /* piece of cake 111-115 */
|
|
|
|
/*---------------------- animation audio files -----------------------*/
|
|
|
|
v.help = myDir'wav\philhelp.wav'
|
|
v.stop = myDir'wav\philstop.wav'
|
|
v.eat = myDir'wav\phileat.wav'
|
|
v.sleep = myDir'wav\philslep.wav'
|
|
v.wait = myDir'wav\philwait.wav'
|
|
v.ouch = myDir'wav\philouch.wav'
|
|
v.cakewhere = myDir'wav\philstrt.wav'
|
|
v.cakenew = myDir'wav\philcake.wav'
|
|
|
|
v.helptext = "<<< The values of this dialog determine the" ,
|
|
"behavior of the Philosophers' Forks execution <<<"
|
|
|
|
/*----------------------- bitmaps (will be memory loaded) ------------*/
|
|
|
|
vb.bmpblank = myDir'bmp\blank.bmp'
|
|
vb.bmpphil = myDir'bmp\philphil.bmp'
|
|
vb.bmpwait = myDir'bmp\philwait.bmp'
|
|
vb.bmpeat = myDir'bmp\phileat.bmp'
|
|
vb.bmpeat2 = myDir'bmp\phileat2.bmp'
|
|
vb.bmpsleep = myDir'bmp\philslep.bmp'
|
|
vb.bmpouch = myDir'bmp\philouch.bmp'
|
|
vb.bmpfork = myDir'bmp\fork.bmp'
|
|
vb.bmphandr = myDir'bmp\handrite.bmp'
|
|
vb.bmphandl = myDir'bmp\handleft.bmp'
|
|
vb.bmphandrf = myDir'bmp\handfkri.bmp'
|
|
vb.bmphandlf = myDir'bmp\handfkle.bmp'
|
|
vb.bmppiece = myDir'bmp\cakepiec.bmp'
|
|
do i=1 to 11
|
|
icake = 'BMPCAKE'i
|
|
vb.icake = myDir'bmp\cake'i'.bmp'
|
|
end
|
|
|
|
/*---------------------- main logic ----------------------------------*/
|
|
|
|
setUpDlg = .SetUpDialog~new(parms., v., vb.)
|
|
setUpDlg~execute("SHOWTOP")
|
|
|
|
return 0
|
|
|
|
|
|
/*---------------------- requires ooDialog ----------------------------*/
|
|
|
|
::requires 'ooDialog.cls'
|
|
::requires 'samplesSetup.rex'
|
|
|
|
|
|
/*---------------------- setup dialog ---------------------------------*/
|
|
|
|
::class 'SetupDialog' subclass UserDialog
|
|
|
|
::method init
|
|
expose v. vb.
|
|
use arg parms., v., vb.
|
|
self~init:super(parms.)
|
|
self~load(v.setdialog, v.setdialogID, 'CENTER')
|
|
|
|
::method initDialog
|
|
expose msg v. vb.
|
|
msg = .nil
|
|
|
|
-- Set the up down controls. They all have a range from 0 to 1000. Then
|
|
-- we connect the delta postion event notification for the sleeping and
|
|
-- eating time controls so that we can increment them by 5 rather than 1.
|
|
do id = 107 to 109
|
|
self~newUpDown(id)~setRange(0, 1000)
|
|
end
|
|
|
|
self~connectUpDownEvent(107, "DELTAPOS", onDelta)
|
|
self~connectUpDownEvent(108, "DELTAPOS", onDelta)
|
|
|
|
-- Load the bitmaps in to memory
|
|
do i over vb.
|
|
v.i = self~loadBitmap(vb.i)
|
|
end
|
|
|
|
-- The user incremented (or decremented) one of the up down controls. We
|
|
-- intercept the notification so that we can increment (or decrement) by 5
|
|
-- rather than 1.
|
|
::method onDelta
|
|
use arg pos, delta, id, hwnd
|
|
|
|
return .UpDown~deltaPosReply(.true, .false, delta * 5)
|
|
|
|
::method help
|
|
expose msg v.
|
|
if msg = .NIL then ret = Play(v.help, 'yes')
|
|
else if msg~completed then ret = Play(v.help, 'yes')
|
|
else ret = Play()
|
|
msg = self~start("scrollInButton", 110, v.helptext, -
|
|
"Arial", 30, "BOLD", 0, 4, 8)
|
|
return 0
|
|
|
|
::method ok /* run philosophers */
|
|
expose msg v.
|
|
if msg \= .nil then
|
|
if msg~completed=0 then self~scrollInButton(110)
|
|
self~getDataStem(parms.)
|
|
/* philosopher dialog */
|
|
dlg = .phildlg~new(v.)
|
|
if dlg~executeAsync(,"SHOWTOP") = 0 then do
|
|
dlg~myExecute(parms.) /* philosopher animation */
|
|
dlg~endAsyncExecution
|
|
end
|
|
else call errorDialog "Couldn't execute Philosophers Forks Dialog"
|
|
|
|
::method cancel
|
|
expose msg v. vb.
|
|
if msg \= .nil then
|
|
if \msg~completed then self~scrollInButton(110)
|
|
do i over vb. /* bitmaps out of memory */
|
|
self~removeBitmap(v.i)
|
|
end
|
|
self~cancel:super
|
|
|
|
|
|
/*---------------------- animation dialog -----------------------------*/
|
|
|
|
::class 'PhilDlg' subclass UserDialog
|
|
|
|
::attribute stopped unguarded
|
|
|
|
::method init
|
|
expose v.
|
|
use arg v.
|
|
self~init:super
|
|
self~stopped = .false
|
|
self~load(v.anidialog, v.anidialogID, 'CENTER')
|
|
|
|
::method initDialog
|
|
expose f1 f2 f3 f4 f5 p1 p2 p3 p4 p5 v.
|
|
|
|
self~disableControl(1) /* disable stop button */
|
|
do i = 1 to 5
|
|
ret = self~installBitmapButton(v.idp + i, '', v.bmpphil ,,,,"STRETCH INMEMORY")
|
|
ret = self~installBitmapButton(v.idf + i, '', v.bmpfork ,,,,"STRETCH INMEMORY")
|
|
ret = self~installBitmapButton(v.idhl + 10*i, '', v.bmpblank,,,,"STRETCH INMEMORY")
|
|
ret = self~installBitmapButton(v.idhr + 10*i, '', v.bmpblank,,,,"STRETCH INMEMORY")
|
|
ret = self~installBitmapButton(v.idpc + i, '', v.bmpblank,,,,"STRETCH INMEMORY")
|
|
end
|
|
ret = self~installBitmapButton(v.idcake, '', v.bmpblank,,,,"STRETCH INMEMORY")
|
|
|
|
f1 = .fork~new(1, self) /* create 5 forks */
|
|
f2 = .fork~new(2, self)
|
|
f3 = .fork~new(3, self)
|
|
f4 = .fork~new(4, self)
|
|
f5 = .fork~new(5, self)
|
|
|
|
p1 = .phil~new(1,f5,f1, self) /* create 5 philos. */
|
|
p2 = .phil~new(2,f1,f2, self)
|
|
p3 = .phil~new(3,f2,f3, self)
|
|
p4 = .phil~new(4,f3,f4, self)
|
|
p5 = .phil~new(5,f4,f5, self)
|
|
|
|
::method myExecute unguarded /* animate dialog */
|
|
expose f1 f2 f3 f4 f5 p1 p2 p3 p4 p5
|
|
use arg parms.
|
|
reply
|
|
T.sleep = parms.101
|
|
T.eat = parms.102
|
|
T.veat = trunc(T.eat / 2)
|
|
T.vsleep = trunc(T.sleep / 2)
|
|
if parms.104 = 1 then T.side = 100 /* left fork first */
|
|
else if parms.105 = 1 then T.side = 0 /* right */
|
|
else T.side = 50 /* random */
|
|
T.repeats = parms.103
|
|
|
|
self~cake('init') /* set up the cake */
|
|
|
|
m1 = p1~start("run",T.) /* run 5 philsophers */
|
|
m2 = p2~start("run",T.)
|
|
m3 = p3~start("run",T.)
|
|
m4 = p4~start("run",T.)
|
|
m5 = p5~start("run",T.)
|
|
self~enableControl(1) /* enable stop button */
|
|
|
|
-- wait untill the 5 philsopers are done, or the stop button is pushed.
|
|
do while(m1~completed+m2~completed+m3~completed+m4~completed+m5~completed <5) & \self~stopped
|
|
j = SysSleep(.340)
|
|
end
|
|
m1~result /* check 5 phils */
|
|
m2~result
|
|
m3~result
|
|
m4~result
|
|
m5~result
|
|
self~ok:super /* finish dialog */
|
|
|
|
::method ok unguarded /* Stop button */
|
|
expose f1 f2 f3 f4 f5 p1 p2 p3 p4 p5 v.
|
|
self~disableControl(1)
|
|
self~stopped = .true
|
|
call play v.stop,'yes'
|
|
f1~layDown /* take away forks */
|
|
f2~layDown
|
|
f3~layDown
|
|
f4~layDown
|
|
f5~layDown
|
|
|
|
::method cancel unguarded
|
|
self~ok /* stop ourself */
|
|
|
|
::method setPhil unguarded /* philosoph bitmap */
|
|
expose v.
|
|
use arg num, bmp
|
|
self~changeBitmapButton(v.idp + num, value('v.bmp'bmp),,,,'STRETCH INMEMORY')
|
|
|
|
::method setFork unguarded /* fork bitmap */
|
|
expose v.
|
|
use arg num, bmp
|
|
self~changeBitmapButton(v.idf + num, value('v.bmp'bmp),,,,'STRETCH INMEMORY')
|
|
|
|
::method setLeft unguarded /* left hand bitmap */
|
|
expose v.
|
|
use arg num, bmp
|
|
self~changeBitmapButton(v.idhl + num*10, value('v.bmp'bmp),,,,'STRETCH INMEMORY')
|
|
|
|
::method setRight unguarded /* righthand bitmap */
|
|
expose v.
|
|
use arg num, bmp
|
|
self~changeBitmapButton(v.idhr + num*10, value('v.bmp'bmp),,,,'STRETCH INMEMORY')
|
|
|
|
::method setPiece unguarded /* cakepiece bitmap */
|
|
expose v.
|
|
use arg num, bmp
|
|
self~changeBitmapButton(v.idpc + num, value('v.bmp'bmp),,,,'STRETCH INMEMORY')
|
|
|
|
::method cake unguarded /* cake bitmap */
|
|
expose curCake v.
|
|
if arg() = 1 then do
|
|
curCake = -1
|
|
self~audio('cakewhere')
|
|
call SysSleep(2)
|
|
end
|
|
curCake = (curCake+1)//11
|
|
i = curCake + 1
|
|
self~changeBitmapButton(v.idcake, value('v.bmpcake'i),,,,'STRETCH INMEMORY')
|
|
if curCake=10 then self~audio('cakenew')
|
|
|
|
::method audio unguarded /* play a sound */
|
|
expose v.
|
|
use arg act
|
|
ret = play(value('v.'act), 'yes')
|
|
|
|
|
|
/*---------------------- philosopher ---------------------------------*/
|
|
|
|
::class phil /*** philosophers ***/
|
|
|
|
::method init /* initialize */
|
|
expose num rFork lFork dlg
|
|
use arg num, rFork, lFork, dlg
|
|
|
|
::method run /* run the philosop.*/
|
|
expose num rFork lFork dlg
|
|
use arg T.
|
|
x = random(1,100,time('S')*num)
|
|
do i=1 to T.repeats until dlg~stopped /* - run the loop */
|
|
stime = random(T.sleep-T.vsleep,T.sleep+T.vsleep)
|
|
if dlg~stopped then leave /* - stop clicked */
|
|
self~sleep(stime) /* - call sleep */
|
|
if dlg~stopped then leave /* - stop clicked */
|
|
self~wait /* - call wait */
|
|
if random(1,100) < T.side then do /* - pick up forks */
|
|
self~pickLeft(T.eat>20) /* - - left first */
|
|
self~pickRight(T.eat>20)
|
|
end
|
|
else do /* - - right first */
|
|
self~pickRight(T.eat>20)
|
|
self~pickLeft(T.eat>20)
|
|
end
|
|
etime = random(T.eat-T.veat,T.eat+T.veat)
|
|
if dlg~stopped then leave /* - stop clicked */
|
|
self~eat(etime) /* - call eat */
|
|
self~layDownLeft /* - free forks */
|
|
self~layDownRight
|
|
end
|
|
self~done
|
|
return 1
|
|
|
|
::method sleep /* philosoph sleeps */
|
|
expose num dlg
|
|
use arg ds
|
|
dlg~setPhil(num, 'sleep')
|
|
if num=1 & ds>=20 then dlg~audio('sleep')
|
|
if ds > 0 then call msSleep ds*100
|
|
|
|
::method eat /* philosoph eats */
|
|
expose num dlg
|
|
use arg ds
|
|
dlg~setPhil(num, 'eat')
|
|
dlg~cake /* - cake smaller */
|
|
dlg~setPiece(num, 'piece') /* - he gets piece */
|
|
if ds > 0 then do
|
|
if num=1 & ds>=20 then dlg~audio('eat')
|
|
do i = 1 to ds/5 while \dlg~stopped /* - eat, check stop */
|
|
call msSleep 300
|
|
if random(1,50)=11 then
|
|
dlg~~audio('ouch')~setPhil(num, 'ouch')
|
|
else dlg~setPhil(num, 'eat2')
|
|
call msSleep 200
|
|
dlg~setPhil(num, 'eat')
|
|
end
|
|
if \dlg~stopped then call msSleep ds//10 * 100
|
|
end
|
|
dlg~setPiece(num, 'blank')
|
|
|
|
::method wait /* philosoph waits */
|
|
expose num dlg
|
|
dlg~setPhil(num, 'wait')
|
|
|
|
::method pickLeft /* pick left fork */
|
|
expose num dlg lFork
|
|
use arg sound
|
|
dlg~setLeft(num, 'handl')
|
|
lFork~pickUp(num=1 & sound)
|
|
dlg~setLeft(num, 'handlf')
|
|
|
|
::method pickRight /* pick right fork */
|
|
expose num dlg rFork
|
|
use arg sound
|
|
dlg~setRight(num, 'handr')
|
|
rFork~pickUp(num=1 & sound)
|
|
dlg~setRight(num, 'handrf')
|
|
|
|
::method layDownLeft /* down left fork */
|
|
expose num dlg lFork
|
|
dlg~setLeft(num, 'blank')
|
|
lFork~layDown
|
|
|
|
::method layDownRight /* down right fork */
|
|
expose num dlg rFork
|
|
dlg~setRight(num, 'blank')
|
|
rFork~layDown
|
|
|
|
::method done /* philosopher done */
|
|
expose num dlg
|
|
dlg~setPhil(num, 'blank')
|
|
|
|
|
|
/*---------------------- fork ----------------------------------------*/
|
|
|
|
::class fork /*** forks **********/
|
|
|
|
::method init /* initialize */
|
|
expose used num dlg
|
|
use arg num, dlg
|
|
used = 0 /* - forks are free */
|
|
|
|
::method pickUp /* pickUp the fork */
|
|
expose used num dlg
|
|
use arg sound
|
|
if used & sound then dlg~audio('wait')
|
|
guard on when used = 0 /* - wait until free*/
|
|
used = 1 /* - set occupied */
|
|
dlg~setFork(num, 'blank')
|
|
|
|
::method layDown unguarded /* layDown the fork */
|
|
expose used num dlg
|
|
dlg~setFork(num, 'fork')
|
|
used = 0 /* - set to free */
|