|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T m
Length: 20635 (0x509b)
Types: TextFile
Names: »menulife.clu«
└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
└─⟦526ad3590⟧ »EUUGD11/gnu-31mar87/X.V10.R4.tar.Z«
└─⟦2109abc41⟧
└─⟦this⟧ »./X.V10R4/xdemo/menulife.clu«
%% Events of interest:
%%
%% Clear_All Clear the board
%% Set_All Set all cells in the board
%% Randomize Randomly set cells (within randomize area)
%% Stop Stop generating
%% Go Continue generating
%% Mutate Set mutation on or off
%% Single_Step Generate once
%% New_Rules Change rules of generation
%% Set_Cells Set cells alive or dead
%% Expose Expose a region of the board
%% ReSize Resize the board
%% Quit Done
%% Event Caused by
%% None nothing
%% Clear 'c'
%% Randomize 'r'
%% Stop ' '
%% Go '<cr>'
%% Mutate 'm'
%% Single_Step ' ' or middle button
%% New_Rules not-implemented yet
%% Set_Cells left button
%% Expose windowUp (same size)
%% ReSize windowUp (new size)
%% Quit 'q'
%% Clear then Randomize right button
xevent = oneof[
None: null,
Clear_All: null,
Set_All: null,
Randomize: null,
Stop: null,
Go: null,
Mutate: null,
Single_Step: null,
New_Rules: null,
Start_Setting:null,
Set_Cell: null,
Stop_Setting: null,
Expose: null,
ReSize: null,
Select: sel_event,
Quit: null
]
sel_event = struct[
Menu: menu,
Item: menu_item
]
eNone = xevent$Make_None(nil)
eClear_All = xevent$Make_Clear_All(nil)
eSet_All = xevent$Make_Set_All(nil)
eRandomize = xevent$Make_Randomize(nil)
eStop = xevent$Make_Stop(nil)
eGo = xevent$Make_Go(nil)
eMutate = xevent$Make_Mutate(nil)
eSingle_Step = xevent$Make_Single_Step(nil)
eNew_Rules = xevent$Make_New_Rules(nil)
eStart_Setting = xevent$Make_Start_Setting(nil)
eSet_Cell = xevent$Make_Set_Cell(nil)
eStop_Setting = xevent$Make_Stop_Setting(nil)
eExpose = xevent$Make_Expose(nil)
eReSize = xevent$Make_ReSize(nil)
eQuit = xevent$Make_Quit(nil)
qi = sequence[int]
ai = array[int]
ab = array[bool]
ae = array[xevent]
gapsize = 1
pwidth = 8
cwidth = pwidth - gapsize
right_Arrow = "\000\002\000\003\200\003\300\003" ||
"\340\003\360\003\370\003\374\003" ||
"\376\003\377\003\360\003\260\003" ||
"\030\003\030\002\014\000\014\000"
ra_Width = 10
ra_Height = 16
ra_X = 9
ra_Y = 0
left_Arrow = "\000\000\002\000\006\000\016\000\036\000\076\000" ||
"\176\000\376\000\376\001\376\003\376\007\176\000" ||
"\156\000\306\000\302\000\200\001\200\001\000\000"
left_Mask = "\003\000\007\000\017\000\037\000\077\000\177\000" ||
"\377\000\377\001\377\003\377\007\377\017\377\017" ||
"\377\000\357\001\347\001\303\003\300\003\200\001"
la_Width = 12
la_Height = 18
la_X = 1
la_Y = 1
info_rec = record[
Arena: field,
W: x_window ]
ints = sequence[int]
vNormalHNs = ints$[ -1, -1, -1, 0, 0, 1, 1, 1 ]
vNormalWNs = ints$[ -1, 0, 1, -1, 1, -1, 0, 1 ]
vKnightHNs = ints$[ -2, -2, -1, -1, 1, 1, 2, 2 ]
vKnightWNs = ints$[ -1, 1, -2, 2, -2, 2, -1, 1 ]
vDiamondHNs = ints$[ -2, -1, -1, 0, 0, 1, 1, 2 ]
vDiamondWNs = ints$[ 0, -1, 1, -2, 2, -1, 1, 0 ]
vTest1HNs = ints$[ -2, -1, -1, 0, 0, 1, 1, 2 ]
vTest1WNs = ints$[ -2, -1, 0, -1, 1, 0, 1, 2 ]
vTest2HNs = ints$[ -1, -1, -1, 0, 0, 1, 2, 2 ]
vTest2WNs = ints$[ -1, 0, 1, -1, 1, 0, -2, 2 ]
vTest3HNs = ints$[ -1, -1, -1, 0, 0, 1, 2, 1 ]
vTest3WNs = ints$[ -1, 0, 1, -1, 2, 0, -2, 1 ]
vTest4HNs = ints$[ -1, -1, -1, 0, 0, 1, 2, 2 ]
vTest4WNs = ints$[ -1, 0, 1, -1, 2, -1, 0, 2 ]
rule_info = record[
Rule_MI: menu_item,
HNs: ints,
WNs: ints
]
rules = array[rule_info]
MenuLifeDemo = proc ()
x_keymap$Load("")
bwidth: int := int$parse(xdemo_default("menulife", "BorderWidth"))
except when not_found, overflow, bad_format: bwidth := 2 end
back: x_pixmap := x_display$White()
bdr: x_pixmap := x_display$Black()
backpix: int := WhitePixel
forepix: int := BlackPixel
mousepix: int := BlackPixel
if x_display$Cells() > 2
then begin
r, g, b: int := x_parse_color(xdemo_default("menulife", "Border"))
bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
end except when not_found: end
begin
r, g, b: int := x_parse_color(xdemo_default("menulife", "Background"))
backpix := x_display$alloc_color(r, g, b)
back := x_pixmap$tile(backpix)
end except when not_found: end
begin
r, g, b: int := x_parse_color(xdemo_default("menulife", "Foreground"))
forepix := x_display$alloc_color(r, g, b)
mousepix := forepix
end except when not_found: end
begin
r, g, b: int := x_parse_color(xdemo_default("menulife", "Mouse"))
mousepix := x_display$alloc_color(r, g, b)
end except when not_found: end
end
F: x_font := x_font$Create("8x13")
W: x_window, XWidth, YHeight: int := x_tcons("menulife", back, bdr,
xdemo_geometry(), "=40x40+1+1",
F, 8, 8, 1, 3, 3, bwidth)
x_font$Destroy(F)
x_window$Set_Resize(W, 1, 8, 1, 8)
W.Name := "menulife"
x_window$Map(W)
x_input$Set_Squish(false)
Cr: x_cursor := x_cursor$SCons(la_Width, la_Height,
left_Arrow, left_Mask,
mousepix, backpix,
la_X, la_Y, GXcopy)
W.Input := keyPressed + keyReleased +
buttonPressed + buttonReleased +
exposeRegion
MFN: string := xdemo_default("menulife", "MenuFont")
except when not_found: MFN := "kiltercrn" end
MF: x_font := x_font$Create(MFN)
MenuBack: int := WhitePixel
MenuPlane: int := 1
MenuMouse: int := BlackPixel
if x_display$Cells() > 2
then begin
r, g, b: int := x_parse_color(xdemo_default("menulife", "MenuMouse"))
MenuMouse := x_display$alloc_color(r, g, b)
end except when not_found: end
cfore: string := xdemo_default("menulife", "MenuForeground")
cback: string := xdemo_default("menulife", "MenuBackground")
pixs: pixellist
pixs, MenuPlane := x_display$Alloc_Cells(1, 1, false)
MenuBack := pixs[1]
r, g, b: int := x_parse_color(cfore)
x_display$store_color(MenuBack + MenuPlane, r, g, b)
r, g, b := x_parse_color(cback)
x_display$store_color(MenuBack, r, g, b)
end except when not_found: end
MB: menu_bar := menu_bar$Init(W, MF, MenuBack, MenuPlane, MenuMouse)
Quit_Menu: menu := menu$New(MB, "Exit")
Quit_MI: menu_item := menu_item$Create(MB, "Quit", MF)
menu$Append(Quit_Menu, Quit_MI)
Cntl_Menu: menu := menu$New(MB, "Control")
Go_MI: menu_item := menu_item$Create(MB, "Go", MF)
menu$Append(Cntl_Menu, Go_MI)
menu$Append(Cntl_Menu, menu_item$Empty(MB))
Mutate_MI: menu_item := menu_item$Create(MB, "Mutate", MF)
menu$Append(Cntl_Menu, Mutate_MI)
menu$Append(Cntl_Menu, menu_item$Empty(MB))
Clear_All_MI: menu_item := menu_item$Create(MB, "Clear All", MF)
menu$Append(Cntl_Menu, Clear_All_MI)
Set_All_MI: menu_item := menu_item$Create(MB, "Set All", MF)
menu$Append(Cntl_Menu, Set_All_MI)
Randomize_MI: menu_item := menu_item$Create(MB, "Randomize", MF)
menu$Append(Cntl_Menu, Randomize_MI)
Rule_List: rules := rules$[]
Rule_MI: menu_item := menu_item$Create(MB, "Normal", MF)
Rule_MI.Checked := true
rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
HNs: vNormalHNs,
WNs: vNormalWNs
})
Rule_MI := menu_item$Create(MB, "Knight", MF)
rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
HNs: vKnightHNs,
WNs: vKnightWNs
})
Rule_MI := menu_item$Create(MB, "Diamond", MF)
rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
HNs: vDiamondHNs,
WNs: vDiamondWNs
})
Rule_MI := menu_item$Create(MB, "Test1", MF)
rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
HNs: vTest1HNs,
WNs: vTest1WNs
})
Rule_MI := menu_item$Create(MB, "Test2", MF)
rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
HNs: vTest2HNs,
WNs: vTest2WNs
})
Rule_MI := menu_item$Create(MB, "Test3", MF)
rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
HNs: vTest3HNs,
WNs: vTest3WNs
})
Rule_MI := menu_item$Create(MB, "Test4", MF)
rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
HNs: vTest4HNs,
WNs: vTest4WNs
})
Rule_Menu: menu := menu$New(MB, "Rules")
for RI: rule_info in rules$Elements(Rule_List) do
menu$Append(Rule_Menu, RI.Rule_MI)
end
menu_bar$Append(MB, Quit_Menu)
menu_bar$Append(MB, Cntl_Menu)
menu_bar$Append(MB, Rule_Menu)
Stopped: bool := true
EQ: event_queue := event_queue$Create()
event_queue$Queue_Event(EQ, eReSize)
No_Changes: bool := false
Height: int := -1
Width: int := -1
Last_I: int := -1
Last_J: int := -1
Setting: bool := false
Set_It: bool := false
Was_Stopped: bool := true
Mutating: bool := false
Mutate_Count: int := 0
Next_Mutate: int := 5
while (true) do
Arena: field
Info: info_rec := info_rec${ Arena: Arena,
W: W }
if (Mutating)
then if (random$Next(100) < 2)
then Mutate(Arena, W)
elseif (false)
then Mutate_Count := Mutate_Count + 1
if (Mutate_Count >= Next_Mutate)
then Mutate(Arena, W)
Next_Mutate := 5 + random$Next(10) + 1
Mutate_Count := 0
end
end
No_Changes := false
end
Next_Event: xevent, X, Y, Wd, Ht: int :=
event_queue$Next_Event[info_rec](EQ,
MB,
(Stopped cor
No_Changes),
Expose_Handler,
Info
)
tagcase Next_Event
tag ReSize:
if ((Width = (X / pwidth)) cand
(Height = (Y / pwidth)))
then Expose_Region(X, Y, Wd, Ht, Arena, W)
No_Changes := false
continue
end
Sx, Sy, Bw, Sm, Wk: int
IW: x_window
Sx, Sy, Width, Height, Bw, Sm, Wk, IW := x_window$Query(W)
if ((Height < pwidth) cor
(Width < pwidth))
then x_window$Destroy(W)
return
end
if (((Height // pwidth) ~= gapsize) cor
((Width // pwidth) ~= gapsize))
then Height := pwidth * (Height / pwidth) + gapsize
Width := pwidth * (Width / pwidth) + gapsize
x_window$Change(W, Width, Height)
end
x_window$Clear(W)
W.Cursor := x_cursor$None()
x_flush()
Width := Width / pwidth
Height := Height / pwidth
for RI: rule_info in rules$Elements(Rule_List) do
if (RI.Rule_MI.Checked)
then %% First through away old field so GC can reclaim it.
Arena := _cvt[null, field](nil)
Arena := field$Create(Height, Width, pwidth, gapsize,
RI.HNs, RI.WNs, forepix, backpix)
break
end
end
Span: int := Width * Height
Span := Span - Width
W.Cursor := Cr
No_Changes := false
tag None:
if (~ Stopped)
then No_Changes := ~ field$Display_Changes(Arena,
W, cwidth)
end
tag Clear_All:
x_window$Clear(W)
field$Clear(Arena)
No_Changes := false
tag Set_All:
Set_All(Arena, W)
No_Changes := false
tag Randomize:
Randomize(Arena, W)
No_Changes := false
tag Stop:
Stopped := true
No_Changes := false
Go_MI.Text := "Go"
menu$Item_Changed(Cntl_Menu, Go_MI)
tag Go:
Stopped := false
No_Changes := ~ field$Display_Changes(Arena,
W, cwidth)
Go_MI.Text := "Stop"
menu$Item_Changed(Cntl_Menu, Go_MI)
tag Mutate:
Mutating := ~ Mutating
Mutate_MI.Checked := ~ Mutate_MI.Checked
tag Single_Step:
if (Stopped)
then event_queue$Queue_Event(EQ, eGo)
event_queue$Queue_Event(EQ, eStop)
else event_queue$Queue_Event(EQ, eStop)
end
No_Changes := false
continue
tag New_Rules:
tag Start_Setting:
W.Input := keyPressed + keyReleased +
buttonPressed + buttonReleased +
exposeRegion + mouseMoved
Last_I, Last_J, Set_It := Set_Cell(X, Y,
-1, -1,
true,
Arena, W)
Setting := true
Was_Stopped := Stopped
Stopped := true
tag Set_Cell:
if (Setting)
then Dummy_Set_It: bool
Last_I, Last_J, Dummy_Set_It := Set_Cell(X, Y,
Last_I, Last_J,
Set_It,
Arena, W)
No_Changes := false
end
tag Stop_Setting:
W.Input := keyPressed + keyReleased +
buttonPressed + buttonReleased +
exposeRegion
Setting := false
Stopped := Was_Stopped
tag Expose:
Expose_Region(X, Y, Wd, Ht, Arena, W)
No_Changes := false
tag Quit:
x_window$Destroy(W)
return
tag Select (SE: sel_event):
if (SE.Menu = Quit_Menu)
then if (SE.Item = Quit_MI)
then x_window$Destroy(W)
return
end
elseif (SE.Menu = Cntl_Menu)
then if (SE.Item = Go_MI)
then if (Stopped)
then event_queue$Queue_Event(EQ, eGo)
else event_queue$Queue_Event(EQ, eStop)
end
elseif (SE.Item = Mutate_MI)
then event_queue$Queue_Event(EQ, eMutate)
elseif (SE.Item = Clear_All_MI)
then event_queue$Queue_Event(EQ, eClear_All)
elseif (SE.Item = Set_All_MI)
then event_queue$Queue_Event(EQ, eSet_All)
elseif (SE.Item = Randomize_MI)
then event_queue$Queue_Event(EQ, eRandomize)
end
elseif (SE.Menu = Rule_Menu)
then for RI: rule_info in rules$Elements(Rule_List) do
if (RI.Rule_MI.Checked)
then if (RI.Rule_MI ~= SE.Item)
then RI.Rule_MI.Checked := false
end
else if (RI.Rule_MI = SE.Item)
then RI.Rule_MI.Checked := true
event_queue$Queue_Event(EQ, eReSize)
end
end
end
end
end
end
end MenuLifeDemo
Expose_Handler = proc (W: x_window, X: int, Y: int, Width: int, Height: int,
Sub_W: x_window, Info: info_rec)
if (W = Info.W)
then Expose_Region(X, Y, Width, Height, Info.Arena, Info.W)
end
end Expose_Handler
Randomize = proc (Arena: field, W: x_window)
for I: int, J: int, Is_Set: bool in field$Random_Changes(Arena) do
XC: int := (I - 1) * pwidth + gapsize
YC: int := (J - 1) * pwidth + gapsize
if (Is_Set)
then %% Set a cell
x_window$Pix_Set(W, Arena.SetPix, YC, XC, cwidth, cwidth)
else %% Clear a cell
x_window$Pix_Set(W, Arena.ClearPix, YC, XC, cwidth, cwidth)
end
end
end Randomize
Mutate = proc (Arena: field, W: x_window)
Num_Cells: int := field$Size(Arena)
Height: int, Width: int := field$Dimensions(Arena)
%% Num_Mutates: int := ((Num_Cells * (random$Next(5) + 1)) / 1000) + 1
Num_Mutates: int := 1
for N: int in int$From_To(1, Num_Mutates) do
I: int := random$Next(Height) + 1
J: int := random$Next(Width) + 1
field$Set_Alive(Arena, I, J,
(~ field$Is_Alive(Arena, I, J)))
field$Display_Cell(Arena, I, J,
W, cwidth )
end
end Mutate
Expose_Region = proc (X1: int, Y1: int, Width: int, Height: int,
Arena: field, W: x_window)
Width := (X1 + Width - 1) / pwidth
Height := (Y1 + Height - 1) / pwidth
X1 := X1 / pwidth
Y1 := Y1 / pwidth
for I: int in int$From_To(Y1, Height) do
for J: int in int$From_To(X1, Width) do
if (field$Is_Alive(Arena, I+1, J+1))
then x_window$Pix_Set(W, Arena.SetPix,
((J * pwidth) + gapsize),
((I * pwidth) + gapsize),
cwidth, cwidth)
end
except when bounds:
end
end
end
end Expose_Region
Set_All = proc (Arena: field, W: x_window)
Height: int, Width: int := field$Dimensions(Arena)
for X: int in int$From_To(1, Height) do
for Y: int in int$From_To(1, Width) do
if (~ field$Is_Alive(Arena, X, Y))
then field$Set_Alive(Arena, X, Y, true)
field$Display_Cell(Arena, X, Y, W, cwidth)
end
end
end
end Set_All
Set_Cell = proc (X: int, Y: int, Last_I: int, Last_J: int, Set_It: bool,
Arena: field, W: x_window)
returns (int, int, bool)
J: int := int$Max(0, (X - gapsize)) / pwidth + 1
I: int := int$Max(0, (Y - gapsize)) / pwidth + 1
if (Last_I = -1)
then Set_It := ~ field$Is_Alive(Arena, I, J)
elseif ((Last_I = I) cand (Last_J = J))
then return (I, J, Set_It)
end
field$Set_Alive(Arena, I, J, Set_It)
except when Bounds:
return (Last_I, Last_J, Set_It)
end
field$Display_Cell(Arena, I, J,
W, cwidth)
return (I, J, Set_It)
end Set_Cell
\f
event_queue = cluster is create, queue_event, next_event
full_event = struct[ E: xevent,
X: int,
Y: int,
X0: int,
Y0: int ]
queue = array[full_event]
rep = record[event: event,
queue: queue]
Create = proc () returns (cvt)
return (rep${event: x_input$Empty_Event(),
queue: queue$New()})
end Create
Queue_Event = proc (EQ: cvt, E: xevent)
queue$AddH(EQ.Queue, full_event${ E: E,
X: 0,
Y: 0,
X0: 0,
Y0: 0 })
end Queue_Event
Next_Event = proc [evt: type] (EQ: cvt, MB: menu_bar, Wait: bool,
Exp_Handler: ehproc, EHArg: evt)
returns (xevent, int, int, int, int)
ehproc = proctype(x_window, int, int, int, int, x_window, evt)
while (true) do
if (queue$Empty(EQ.Queue))
then if (Wait cor
x_input$Pending())
then x_input$DeQ(EQ.Event)
if (EQ.Event.Kind = KeyPressed)
then Ch: char := Lower(x_keymap$GetC(
EQ.Event.Value,
EQ.Event.Mask))
except when none, multi (*): continue end
%% Interpret char
if (Ch = 'c')
then return (eClear_All,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (Ch = 's')
then return (eSet_All,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (Ch = ' ')
then return (eSingle_Step,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (Ch = 'r')
then return (eRandomize,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (Ch = 'm')
then return (eMutate,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (Ch = '\r')
then return (eGo,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (Ch = 'q')
then return (eQuit,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
end
elseif (EQ.Event.Kind = ButtonPressed cand
EQ.Event.Value = LeftButton)
then %% Start setting cells
return (eStart_Setting,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (EQ.Event.Kind = ButtonReleased cand
EQ.Event.Value = LeftButton)
then %% Stop setting cells
return (eStop_Setting,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (EQ.Event.Kind = ButtonPressed cand
EQ.Event.Value = RightButton)
then return (eSingle_Step,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (EQ.Event.Kind = ButtonReleased cand
EQ.Event.Value = RightButton)
then %% Ignore
continue
elseif (EQ.Event.Kind = ButtonPressed cand
EQ.Event.Value = MiddleButton)
then M: menu, MI: menu_item :=
menu_bar$Select[evt](MB, EQ.Event.X, EQ.Event.Y, Exp_Handler, EHArg)
except when None:
continue
end
return (xevent$Make_Select(
sel_event${
Menu: M,
Item: MI }),
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (EQ.Event.Kind = ButtonReleased cand
EQ.Event.Value = MiddleButton)
then %% Ignore
% continue
elseif (EQ.Event.Kind = mouseMoved)
then %% Mouse has moved
return (eSet_Cell,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
elseif (EQ.Event.Kind = ExposeWindow)
then return (eReSize,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
else return (eExpose,
EQ.Event.X, EQ.Event.Y,
EQ.Event.X0, EQ.Event.Y0)
end
else return (eNone, 0, 0, 0, 0)
end
else EQ.Queue.Low := 1
FE: full_Event := queue$RemL(EQ.Queue)
return (FE.E, FE.X, FE.Y, FE.X0, FE.Y0)
end
end
end Next_Event
end event_queue