• Keine Ergebnisse gefunden

A Client for the Z21 Model Railway Control

N/A
N/A
Protected

Academic year: 2022

Aktie "A Client for the Z21 Model Railway Control"

Copied!
71
0
0

Wird geladen.... (Jetzt Volltext ansehen)

Volltext

(1)

A Client for the Z21 Model Railway Control

An exercise in Haskell

Sven Eric Panitz

Hochschule RheinMain

This document contains the implementation of a Z21 modell railway control client. The implementation is completely done in Haskell.

This project started as a little exercise in Haskell. The goal is to control a digital model railway. As server a z21 control unit is used. Z21 and z21 are products of Modelleisenbahn GmbH. They can be pruchased by Roco and Fleischmann model railways.

The z21 control unit communicates with clients by means of UDP. The

here presented program is able to control locomotives. Furthermore it is

possible to program automatic sequences as trains commuting between

to points.

(2)
(3)

Contents

1 Introduction 5

1.1 Motivation . . . . 5

1.2 Overview . . . . 5

1.3 Related Works . . . . 6

2 The Z21 Protocoll 7 2.1 Messages . . . . 7

2.2 Sending . . . . 9

2.3 Receiving . . . . 11

3 Global State 15 3.1 Data Types . . . . 15

3.2 Construction . . . . 16

3.3 Getter Functions . . . . 16

3.4 Setter Functions . . . . 17

4 Graphical user interface 19 4.1 Controls . . . . 19

4.1.1 Construction . . . . 20

4.2 Updates . . . . 20

4.3 Layout . . . . 21

4.4 Event Handler . . . . 23

4.5 Overall Window Creation . . . . 25

5 Message handling 27 5.1 Special handlers . . . . 29

6 Automatic Commuting 31 6.1 GUI . . . . 34

6.1.1 Layout . . . . 35

6.1.2 Events . . . . 36

7 Main GUI Client 39 8 Command language 43 8.1 Scripting . . . . 43

8.2 Execution of commands . . . . 46

(4)

Contents

8.3 Some useful commands (in German) . . . . 48

8.3.1 English Translation . . . . 49

8.3.2 Example Script . . . . 50

8.4 Making Command an instance of Monad . . . . 51

8.5 Command language parser . . . . 52

8.5.1 Lexer and Parsing of Token . . . . 53

8.5.2 Grammar . . . . 54

8.5.3 Executing Scripts . . . . 57

8.5.4 Example Script . . . . 59

9 Conclusion 61

A Constants 65

B Utility Functions 67

C A Simple Test Server 69

(5)

Chapter 1 Introduction

1.1 Motivation

The two goals of this project are: writing a Haskell application and having fun with model railways.

For the first goal: I have known Haskell as programming language from the very beginning in the early nineties, i.e. the time before the arrival of monads. I have done quite a lot of programming in Haskell during the nineties. Then for about the last 15 years I had to focus on mainstream languages. (My last serious activity with Haskell was a small tutorial for hopengl [Pan03]). I worked on larger Java projects and teach Java in introductory courses. With this strong background on object oriented languages I was interested on how it feels, to write an application in Haskell. An application that I typically would have written in a language as Java.

Or at least in something like Scala.

This project is rather small. However it has a lot of aspects that make it interesting.

It contains a graphical user interface. It entails network communication. It needs global state information. It needs low level bit operations for binary data. And it addresses questions of concurrency. The only aspects it lacks is some persistency layer.

I was interested in the question: How are these things solved in a lazy evaluated programming language. How can typical object oriented patterns be implemented in Haskell?

1.2 Overview

This documention contains the complete source code of the project. We give a short overview of the modules:

• The first module presented Z21.Protocoll contains the communication layer

of the project. It provides code to send and recieve UDP packages to and

from the Z21 control unit.

(6)

Chapter 1 Introduction

• The module Z21.State contains a data structure for the global state of the Z21 client. It is information on which loco address is running in which direction at which speed. this module currently is rather inmature.

• A GUI component is provided by the module Z21.Gui. As GUI library gtk2hs is used.

• Some means to react to incoming messages are provided in the module Z21.MessageEventListener. It tries to implement some pattern for event driven actions.

• A dedicated module for programming automatically commuting trains is given by Z21.Commuting.

• The main function for starting the GUI of the project is given in module Client.

• Eventually we create a scripting language. The language enables the user to program arbitrary automatic sequences for a railway layout. A parser for the script language is implemented and scripts can be started from the command line. No GUI component is provided for this part of the project.

1.3 Related Works

A mature open source library for model train control exists: JMRI. JMRI stands

for: Java modell railroad interface. [Com97] Quite a number of applications use this

library. It is a huge project. It contains among a lot of other things an implementa-

tion of the Z21 protocoll. As the name says: it is implemented in the programming

language Java.

(7)

Chapter 2

The Z21 Protocoll

This module implements communication with the Z21 server via User Datagram Protocol (UDP). The protocoll for communication with the Z21 server is defined in [Gmb13]. This module represents the transport layer of our application.

For communication we need the Haskell ByteString module. We need unsigned words as provided by the module Data.Word and do some bit manipulations as provided by the module Data.Bits. Therefore the following imports are done.

1 module Z21 . P r o t o c o l l where

2

3 import q u a l i f i e d Data . B y t e S t r i n g a s BS

4 import Network . S o c k e t . B y t e S t r i n g

5

6 import Data . B i t s

7 import Data . Word

2.1 Messages

First of all we define a data type for the Z21 messages. Every message is represented by a constructor. Some messages have further information like the address of a locomotive or the speed for a locomotive. Some messages have complex information.

In these cases the record syntax with named fields is used.

1 data Message

2 = LAN_GET_SERIAL_NUMBER

3 |LOGOFF

4 |LAN_X_GET_VERSION

5 |LAN_X_GET_STATUS

6 |LAN_X_SET_TRACK_POWER_OFF

7 |LAN_X_SET_TRACK_POWER_ON

8 |LAN_X_BC_TRACK_POWER_ON

9 |LAN_X_BC_TRACK_POWER_OFF

(8)

Chapter 2 The Z21 Protocoll

10 |LAN_X_SET_STOP

11 |LAN_X_GET_LOCO_INFO I n t

12 |LAN_X_SET_LOCO_DRIVE

13 { l o c I D : :Int , s t e p s : : Word8 , s p e e d : : Word8 , d i r e c t i o n : : D i r e c t i o n }

14 |LAN_X_SET_LOCO_FUNCTION

15 { l o c I D : :Int , s w i t c h : : FunctionSwitch , i n d e x: : Word8}

16 |LAN_X_GET_FIRMWARE_VERSION

17 |LAN_GET_BROADCASTFLAGS

18 |LAN_SET_BROADCASTFLAGS{ g e n e r a l : :Bool, rb u s : :Bool, s y s t e m S t a t e : :Bool}

19 |LAN_GET_LOCOMODE I n t

20 |LAN_SET_LOCOMODE { l o c I d : : Int , mode : : LOC_MODE}

21 |LAN_GET_HWINFO

22 |LAN_X_LOCO_INFO

23 { l o c I D : :I n t

24 , busy : :Bool

25 , s t p e s : : Spe ed S t e p s

26 , d i r e c t i o n : : D i r e c t i o n

27 , s p e e d : : Word8

28 , d o u b l e T r a c t i o n : :Bool

29 , smartSearc h : :Bool

30 , l i g h t : :Bool

31 , f 1 : :Bool

32 , f 2 : :Bool

33 , f 3 : :Bool

34 , f 4 : :Bool

35 }

36 |LAN_RMBUS_GETDATA Word8

37 |LAN_RMBUS_DATACHANGED [ Word8 ]

38 |SERIAL_NUMBER

39 |LAN_X_SET_TURNOUT Word16 Bool Bool

40 |LAN_X_GET_TURNOUT_INFO Word16

41 |LAN_X_TURNOUT_INFO Word16 Word8

42 |LAN_X_UNKNOWN_COMMAND

43 |UNKNOWN [ Word8 ]

44 d e r i v i n g Show

Some more data types are used within this definition. First of all a simple enum type for the direction of a locomotive:

1 data D i r e c t i o n = Forward | Backward d e r i v i n g (Eq,Show,Read,Enum)

2

3 s w i t c h D i r e c t i o n Forward = Backward

4 s w i t c h D i r e c t i o n Backward = Forward

5

6 i s F o r w a r d = (==)Forward

We need a type to denote the protocoll of a locomotives decoder. Currently two

different decoder formats are known. The standard dcc format and motorolas mm

(9)

2.2 Sending

format.

1 data LOC_MODE = DCC|MM d e r i v i n g (Show,Eq)

2 isDCC = (==)DCC

For switches (e.g. light) there are three commands. Turning it off or on and simple switching it.

1 data F u n c t i o n S w i t c h = On | O f f | Switch d e r i v i n g (Show,Eq)

2

3 f u n c t i o n S w i t c h C o d e : : F u n c t i o n S w i t c h > Word8

4 f u n c t i o n S w i t c h C o d e On = 0 x00

5 f u n c t i o n S w i t c h C o d e O f f = 0 x40

6 f u n c t i o n S w i t c h C o d e Switch = 0 x80

Finally there are three different types for decoder speed selection: 14, 28 and 128 steps.

1 data S p e e d S t e p s = S14 | S28 | S128 d e r i v i n g (Show,Eq)

Currently the implementation does not realy bother about these three different types. We alway assume 128 steps.

2.2 Sending

This paragraph contains the implementation of function mkmessage for serializing Z21 messages as a byte string in order to send them as UDP message to the z21 server. For each message a list of 8 bit words is created. The function pack from module Data.ByteString is applied to create the byte string.

We use the hexadecimal notation for the 8 bit words directly from the specification of the protocoll [Gmb13].

1 mkMessage LAN_GET_SERIAL_NUMBER = BS . pack [ 0 x04 , 0 x00 , 0 x10 , 0 x00 ]

2 mkMessage LAN_GET_HWINFO = BS . pack [ 0 x04 , 0 x00 , 0x1A , 0 x00 ]

3 mkMessage LOGOFF = BS . pack [ 0 x08 , 0 x00 , 0 x10 , 0 x00 ]

4 mkMessage LAN_X_GET_VERSION

5 = BS . pack [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x21 , 0 x00 ]

6 mkMessage LAN_X_GET_STATUS

7 = BS . pack [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x24 , 0 x05 ]

8 mkMessage LAN_X_SET_TRACK_POWER_OFF

(10)

Chapter 2 The Z21 Protocoll

9 = BS . pack [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x80 , 0 xA1 ]

10 mkMessage LAN_X_SET_TRACK_POWER_ON

11 = BS . pack [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x81 , 0 xA0 ]

12 mkMessage LAN_X_SET_STOP = BS . pack [ 0 x06 , 0 x00 , 0 x40 , 0 x00 , 0 x80 , 0 x80 ]

13 mkMessage (LAN_X_GET_LOCO_INFO l o c I D )

14 = BS . pack [ 0 x09 , 0 x00 , 0 x40 , 0 x00 , xheader , db0 , db1 , db2 , x o r b y t e ]

15 where

16 xheader = 0xE3

17 db0 = 0xF0

18 [ db1 , db2 ] = mkdLocIDBytes l o c I D

19 x o r b y t e = xheader ‘ xor ‘ db0 ‘ xor ‘ db1 ‘ xor ‘ db2

20 mkMessage LAN_X_SET_LOCO_DRIVE

21 { l o c I D=locID , s t e p s=s t , s p e e d=sp , d i r e c t i o n=d i r }

22 = msg_LAN_X_SET_LOCO_DRIVE l o c I D s t sp d i r

23 mkMessage LAN_X_SET_LOCO_FUNCTION

24 { l o c I D=locID , s w i t c h=s w i t c h , i n d e x=i n d e x}

25 = msg_LAN_X_SET_LOCO_FUNCTION l o c I D s w i t c h i n d e x

26 mkMessage LAN_X_GET_FIRMWARE_VERSION

27 = BS . pack [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 xF1 , 0 x0A , 0xFB ]

28 mkMessage LAN_GET_BROADCASTFLAGS = BS . pack [ 0 x04 , 0 x00 , 0 x51 , 0 x00 ]

29−−V o r s i c h t . H i e r i s t d i e Dokumentation s e h r i r r e f ü h r e n d

30−− j a j a l i t t l e en d i a n . Dann s c h r e i b t das auch s o a u f !

31 mkMessage LAN_SET_BROADCASTFLAGS

32 { g e n e r a l=g e n e r a l , rb us=rbus , s y s t e m S t a t e=s y s t e m S t a t e }

33 = BS . pack ( [ 0 x08 , 0 x00 , 0 x50 , 0 x00 , byte , sysByte , 0 x00 , 0 x00 ] )

34 where

35 genByte = i f g e n e r a l then 0 x01 : : Word8 e l s e 0

36 rbusByte = i f rb u s then 0 x02 : : Word8 e l s e 0

37 s y s B y t e = i f s y s t e m S t a t e then 0 x01 : : Word8 e l s e 0

38 byte = genByte . | . rbusByte

39 mkMessage (LAN_GET_LOCOMODE l o c I D )

40 = BS . pack ( [ 0 x06 , 0 x00 , 0 x60 , 0 x00]++mkdLocIDBytes l o c I D )

41 mkMessage LAN_SET_LOCOMODE { l o c I d=id, mode=md}

42 = msg_LAN_SET_LOCOMODE i d md

43 mkMessage (LAN_RMBUS_DATACHANGED bs )

44 = BS . pack ( [ 0 x0F , 0 x00 , 0 x80 , 0 x00]++bs )

45 mkMessage (LAN_RMBUS_GETDATA b ) = BS . pack [ 0 x05 , 0 x00 , 0 x81 , 0 x00 , b ]

46 mkMessage (LAN_X_SET_TURNOUT a d d r e s s 1 a c t i v e f i r s t )

47 = BS . pack [ 0 x09 , 0 x00 , 0 x40 , 0 x00 , xheader , db0 , db1 , db2 , x o r b y t e ]

48 where

49 a d d r e s s = a d d r e s s 1+3

50 xheader = 0 x53

51 db0 = f r o m I n t e g r a l $ s h i f t R a d d r e s s 8

52 db1 = f r o m I n t e g r a l a d d r e s s

53 db2 = ( 0 x80 : : Word8 )

54 . | . (i f a c t i v e then ( 0 x08 : : Word8 ) e l s e 0 x00 )

55 . | . (i f f i r s t then ( 0 x01 : : Word8 ) e l s e 0 x00 )

56 x o r b y t e = xheader ‘ xor ‘ db0 ‘ xor ‘ db1 ‘ xor ‘ db2

57 mkMessage (LAN_X_GET_TURNOUT_INFO a d d r e s s )

58 = BS . pack [ 0 x08 , 0 x00 , 0 x40 , 0 x00 , 0 x43 , db0 , db1 , 0 x43 ‘ xor ‘ db0 ‘ xor ‘ db1 ]

59 where

60 db0 = f r o m I n t e g r a l $ s h i f t R a d d r e s s 8

(11)

2.3 Receiving

61 db1 = f r o m I n t e g r a l a d d r e s s

62 mkMessage (LAN_X_TURNOUT_INFO a d d r e s s v a l u e )

63 = BS . pack [ 0 x09 , 0 x00 , 0 x40 , 0 x00 , 0 x43 , db0 , db1 , db2 , x o r b y t e ]

64 where

65 db0 = f r o m I n t e g r a l $ s h i f t R a d d r e s s 8

66 db1 = f r o m I n t e g r a l a d d r e s s

67 db2 = v a l u e

68 x o r b y t e = 0 x43 ‘ xor ‘ db0 ‘ xor ‘ db1 ‘ xor ‘ db2

69 mkMessage (UNKNOWN _) = BS . pack [ 0 x40 , 0 x61 , 0 x82 ]

Thus messages can be send as UDP to the server.

1 sendMsg s o c k e t addr msg = do

2 putStrLn (”> ”++show msg )

3 sendTo s o c k e t ( mkMessage msg ) addr

2.3 Receiving

When receiving a byte string we will read it as a Z21 message. Thus we write the inverse function readMessage. The following equation should hold:

id = readMessage mkMessage

The given implementation uses pattern matching on the list of bytes.

1

1 readMessage = rM . BS . unpack

2 where

3 rM : : [ Word8 ] > Message

4 rM [ 0 x04 , 0 x00 , 0 x10 , 0 x00 ] = LAN_GET_SERIAL_NUMBER

5 rM [ 0 x04 , 0 x00 , 0x1A , 0 x00 ] = LAN_GET_HWINFO

6 rM [ 0 x08 , 0 x00 , 0 x10 , 0 x00 ] = LOGOFF

7 rM [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x21 , 0 x00 ] = LAN_X_GET_VERSION

8 rM [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x24 , 0 x05 ] = LAN_X_GET_STATUS

9 rM [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x80 , 0 xA1 ] = LAN_X_SET_TRACK_POWER_OFF

10 rM [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x21 , 0 x81 , 0 xA0 ] = LAN_X_SET_TRACK_POWER_ON

11 rM [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x61 , 0 x01 , 0 x60 ] = LAN_X_SET_TRACK_POWER_ON

12 rM [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 x61 , 0 x00 , 0 x61 ] = LAN_X_SET_TRACK_POWER_OFF

13 rM [ 0 x06 , 0 x00 , 0 x40 , 0 x00 , 0 x80 , 0 x80 ] = LAN_X_SET_STOP

14 rM [ 0 x09 , 0 x00 , 0 x40 , 0 x00 , 0 xE3 , 0 xF0 , 0 xE3 , db1 , db2 , x o r b y t e ]

15 = LAN_X_GET_LOCO_INFO ( mkLocoInfo db1 db2 )

16 rM [ 0 x0A , 0 x00 , 0 x40 , 0 x00 , 0 xE4 , 0 xF8 , db1 , db2 , db3 , x o r b y t e ]

1I am sure there is a much smarter way to implement this. The list of bytes coding a message is written in both functionsmkMessageandreadMessage. This seems to be error prone.

(12)

Chapter 2 The Z21 Protocoll

17 = LAN_X_SET_LOCO_FUNCTION

18 { l o c I D = ( mkLocoInfo db1 db2 )

19 , s w i t c h = i f ( db3 . & . 0xC0 == 0 ) then O f f

20 e l s e i f ( db3 . & . 0xC0 == 0xC0 ) then On

21 e l s e Switch

22 , i n d e x = db3 . & . 0x3F}

23 rM [ 0 x0A , 0 x00 , 0 x40 , 0 x00 , 0 xE4 , db0 , db1 , db2 , db3 , x o r b y t e ]

24 = LAN_X_SET_LOCO_DRIVE

25 { l o c I D = ( mkLocoInfo db1 db2 )

26 , s t e p s = db0 ‘mod‘ 16

27 , s p e e d = db3 ‘mod‘ 1 2 8

28 , d i r e c t i o n = i f db3 >= 128 then Forward e l s e Backward }

29 rM [ 0 x07 , 0 x00 , 0 x40 , 0 x00 , 0 xF1 , 0 x0A , 0xFB ]

30 = LAN_X_GET_FIRMWARE_VERSION

31 rM [ 0 x04 , 0 x00 , 0 x51 , 0 x00 ] = LAN_GET_BROADCASTFLAGS

32 rM [ 0 x06 , 0 x00 , 0 x60 , 0 x00 , hi , l o ]

33 = LAN_GET_LOCOMODE ( (f r o m I n t e g r a l h i ) *256 + (f r o m I n t e g r a l l o ) )

34 rM [ 0 x07 , 0 x00 , 0 x61 , 0 x00 , locIDH , locIDL , mode ]

35 = LAN_SET_LOCOMODE

36 { l o c I d = (f r o m I n t e g r a l locIDH ) *256

37 + (f r o m I n t e g r a l locIDL )

38 , mode = i f mode==0 then DCC e l s e MM}

39 rM ( l : 0 x00 : 0 x40 : 0 x00 : 0 xEF : db0 : db1 : db2 : db3 : db4 :_)

40 = LAN_X_LOCO_INFO

41 { l o c I D = ( mkLocoInfo db0 db1 )

42 , busy = db2 . & . 0 x08 == 0 x08

43 , s t p e s

44 = l e t s t e p = db2 . & . 0 x07

45 i n i f s t e p == 0 then S14

46 e l s e i f s t e p == 1 then S28

47 e l s e S128

48 , d i r e c t i o n = i f db3 . & . 0 x80 == 0 x80

49 then Forward e l s e Backward

50 , s p e e d = db3 . & . 0x7F

51 , d o u b l e T r a c t i o n = db4 . & . 0 x40 == 0 x40

52 , sm a r t S ea r ch = db4 . & . 0 x20 == 0 x20

53 , l i g h t = db4 . & . 0 x10 == 0 x10

54 , f 1 = db4 . & . 0 x01 == 0 x01

55 , f 2 = db4 . & . 0 x02 == 0 x02

56 , f 3 = db4 . & . 0 x04 == 0 x04

57 , f 4 = db4 . & . 0 x08 == 0 x08

58 }

59 rM ( 0 x0F : 0 x00 : 0 x80 : 0 x00 : b y t e s ) = LAN_RMBUS_DATACHANGED b y t e s

60 rM ( 0 x08 : 0 x00 : 0 x10 : 0 x00 : s e r i a l N u m b e r ) = SERIAL_NUMBER

61 rM ( 0 x09 : 0 x00 : 0 x40 : 0 x00 : 0 x43 : db0 : db1 : db2 :_ : [ ] )

62 = LAN_X_TURNOUT_INFO ( ( mkLocoInfo db0 db1 ) +1) db2

63 rM ( 0 x0F : 0 x00 : 0 x40 : 0 x00 : 0 x61 : 0 x82 : 0 xE3 : [ ] ) = LAN_X_UNKNOWN_COMMAND

64 rM b y t e s = UNKNOWN b y t e s

65

66 mkLocoInfo db1 db2

67 = (f r o m I n t e g r a l ( db1 . & . 0x3F ) ) * 2^8

68 + (f r o m I n t e g r a l db2 )

(13)

2.3 Receiving

Some of the more complicated messages are done in seperate functions.

The message for setting a locomotive system mode.

1 msg_LAN_SET_LOCOMODE : : I n t > LOC_MODE> BS . B y t e S t r i n g

2 msg_LAN_SET_LOCOMODE l o c I D locMode

3 = BS . pack [ 0 x07 , 0 x00 , 0 x61 , 0 x00

4 ,f r o m I n t e g r a l ( l o c I D ‘div‘ 2 5 6 )

5 ,f r o m I n t e g r a l ( l o c I D ‘mod‘ 2 5 6 )

6 ,i f isDCC locMode then 0 e l s e 1 ]

The message for getting a locomotive to drive in a certain direction by a certain speed.

1 msg_LAN_X_SET_LOCO_DRIVE l o c I D s t e p s s p e e d d i r e c t i o n

2 = BS . pack [ 0 x0A , 0 x00 , 0 x40 , 0 x00 , xheader , db0 , db1 , db2 , db3 , x o r b y t e ]

3 where

4 xheader = 0xE4

5 db0 = 16+ s t e p s

6 [ db1 , db2 ] = mkdLocIDBytes l o c I D

7 db3 = (i f i s F o r w a r d d i r e c t i o n then 128 e l s e 0 )+s p e e d

8 x o r b y t e = xheader ‘ xor ‘ db0 ‘ xor ‘ db1 ‘ xor ‘ db2 ‘ xor ‘ db3

The message for switching a locomotive’s function.

1 msg_LAN_X_SET_LOCO_FUNCTION l o c I D s w i t c h i n d e x

2 = BS . pack [ 0 x0A , 0 x00 , 0 x40 , 0 x00 , xheader , db0 , db1 , db2 , db3 , x o r b y t e ]

3 where

4 xheader = 0xE4

5 db0 = 0xF8

6 [ db1 , db2 ] = mkdLocIDBytes l o c I D

7 db3 = f u n c t i o n S w i t c h C o d e s w i t c h + i n d e x

8 x o r b y t e = xheader ‘ xor ‘ db0 ‘ xor ‘ db1 ‘ xor ‘ db2 ‘ xor ‘ db3

The decoder address of a locomotive is decoded in two bytes in the following way.

1 mkdLocIDBytes : : I n t > [ Word8 ]

2 mkdLocIDBytes l o c I D =

3 [f r o m I n t e g r a l ( l o c I D ‘div‘ 256 ‘mod‘ (128+64) )

4 ,f r o m I n t e g r a l ( l o c I D ‘mod‘ 2 5 6 ) ]

(14)

Chapter 2 The Z21 Protocoll

(15)

Chapter 3 Global State

This chapter contains the module State. It is the model of the application. The client will keep a global state. This state can be controlled through a graphical user interface. Furthermore the state can get modified through incoming messages from the z21 server. This will be the case, when other clients control trains.

1 module Z21 . S t a t e where

2 import Z21 . P r o t o c o l l

3 ( D i r e c t i o n ( . . ) , S pe ed St ep s ( . . ) , s w i t c h D i r e c t i o n )

4 import Data . Word

3.1 Data Types

The global state is basically a list of locomotive states. One locomotive is the currently controlled locomotive. This will not be included in the list of locomotives.

1 data S t a t e = Z21 { c u r r e n t L o c o : : Loco , l o c o s : : [ Loco ] }

A locomotive state is represented by its address, speed, direction, steps for speed and its light status.

1

1 data Loco = Loco

2 { l i d : :I n t

3 , a d d r e s s : :I n t

4 , s t e p s : : Sp ee d St ep s

5 , s p e e d : : Word8

6 , d i r e c t i o n : : D i r e c t i o n

1We have a field for the address and a further field for some ID. Howerever, currently both are redundantely used. Maybe some day it might be nice to have a database of locomotives with own IDs and some description.

(16)

Chapter 3 Global State

7 , l i g h t : :Bool} d e r i v i n g (Eq,Show)

3.2 Construction

Two functions are provided to create states.

1 newState = l e t ( l : l s ) = map newLoco [ 1 . . 2 0 ]

2 i n Z21{ c u r r e n t L o c o=l , l o c o s=l s }

3

4 newLoco l i d

5 = Loco

6 { l i d=l i d

7 , a d d r e s s = l i d

8 , s t e p s = S128

9 , s p e e d=0

10 , d i r e c t i o n=Forward

11 , l i g h t=True}

12

13 newLocoInState s t l i d = s t { l o c o s=newLoco l i d : l o c o s s t }

3.3 Getter Functions

Some convenient getter functions to retrieve values are provided.

1 g e t D i r e c t i o n O f L o c o l o c o i d s t

2 | l o c o i d == ( l i d $ c u r r e n t L o c o s t ) = d i r e c t i o n $ c u r r e n t L o c o s t

3 |o t h e r w i s e = d i r e c t i o n $ h e a d $ f i l t e r ( \ l o c o>l i d l o c o==l o c o i d ) $ l o c o s s t

4

5 g e t A d d r e s s = a d d r e s s . c u r r e n t L o c o

6 g e t D i r e c t i o n = d i r e c t i o n . c u r r e n t L o c o

7 g e t S p e e d = s p e e d . c u r r e n t L o c o

8 g e t L i g h t = l i g h t . c u r r e n t L o c o

9

10 g et L o co i d [ ] = Nothing

11 g et L o co i d ( l : l s )

12 |i d == l i d l = J u s t l

13 |o t h e r w i s e = ge t L oc o i d l s

(17)

3.4 Setter Functions

The following function is used to change the currently activ locomotive. It creates a new state. If the locomotive with the corresponding ID does not exist in the state, then a new locomotive is created.

1 s e l e c t L o c o l o c o i d s t

2 | l o c o i d == ( l i d $ c u r r e n t L o c o s t ) = s t

3 |Nothing==l o c o = s t { c u r r e n t L o c o=newLoco l o c o i d

4 , l o c o s =( c u r r e n t L o c o s t ) : l o c o s s t }

5 |o t h e r w i s e = l e t (J u s t ( l o c s , l o c ) ) = l o c o

6 i n s t { c u r r e n t L o c o=l o c , l o c o s =( c u r r e n t L o c o s t ) : l o c s }

7 where

8 l o c o = getL o co [ ] ( l o c o s s t )

9

10 getLoco l o c o s [ ] = Nothing

11 getLoco l o c o s ( l : l s )

12 | l i d l == l o c o i d = J u s t ( l o c o s++l s , l )

13 |o t h e r w i s e = g et L oco ( l : l o c o s ) l s

3.4 Setter Functions

In this section some setter functions are defined. Since in Haskell we cannot modify any data, these functions transform the state and return a new state-

1 s e t D i r e c t i o n d i r s t = s t { c u r r e n t L o c o =( c u r r e n t L o c o s t ) { d i r e c t i o n=d i r }}

2 s e t S p e e d sp s t = s t { c u r r e n t L o c o =( c u r r e n t L o c o s t ) { s p e e d=sp }}

3 s e t L i g h t l s t = s t { c u r r e n t L o c o =( c u r r e n t L o c o s t ) { l i g h t=l }}

4

5 r e p l a c e N o n A c t i v e L o c o loco@Loco { l i d=i d} st@Z21 { l o c o s=l s }

6 = s t { l o c o s=map ( \ l>i f l i d l == i d then l o c o e l s e l ) l s }

7

8 c h a n g e D i r e c t i o n O f L o c o l o c o i d st@Z21 { c u r r e n t L o c o=c u r r e n t , l o c o s=l s }

9 | l o c o i d == l i d c u r r e n t

10 = s t { c u r r e n t L o c o=c h a n g e D i r e c t i o n I n L o c o c u r r e n t }

11 |o t h e r w i s e = s t { l o c o s=map

12 ( \ l o c o> i f ( l i d l o c o==l o c o i d )

13 then l o c o

14 e l s e c h a n g e D i r e c t i o n I n L o c o l o c o ) l s }

15

16 s e t D i r e c t i o n O f L o c o l o c o i d d i r st@Z21 { c u r r e n t L o c o=c u r r e n t , l o c o s=l s }

17 | l o c o i d == l i d c u r r e n t

18 = s t { c u r r e n t L o c o=c u r r e n t { d i r e c t i o n=d i r }}

19 |o t h e r w i s e = s t { l o c o s=map

20 ( \ l o c o> i f ( l i d l o c o /= l o c o i d )

21 then l o c o

22 e l s e l o c o { d i r e c t i o n=d i r } ) l s }

23

(18)

Chapter 3 Global State

24

25 c h a n g e D i r e c t i o n I n L o c o l = l { d i r e c t i o n=s w i t c h D i r e c t i o n $ d i r e c t i o n l }

(19)

Chapter 4

Graphical user interface

The module Gui contains the definition of the graphical user interface of the appli- cation. As GUI-library the gtk2hs-library is used. It is a direct Haskell api for the Gtk+ library. A basic tutorial can be found in [vT08].

Some useful hints on gtk2hs and threads can be found on the internet in an article by Daniel Wagner [Wag15].

1 module Z21 . Gui where

2 import Z21 . P r o t o c o l l h i d i n g( l i g h t , d i r e c t i o n , s p e e d )

3 import Z21 . S t a t e

4 import U t i l

5

6 import Data . Word

7

8 import C o n t r o l . Concurrent

9

10 import Gra phi cs . UI . Gtk

4.1 Controls

A data type is defined, which contains all the gui controls of the client application.

These controls may change their values due to modifications of the global state.

1 data G u i C o n t r o l s a

2 = G u i C o n t r o l s

3 { mainBox : : VBox

4 , s t a t u s L a b e l : : TextView

5 , add rLab el : : L abel

6 , s p e e d A d j u s t : : Adjustment

7 , a d d r S e l e c t : : [ Button ]

8 , l i g h t B u t t o n : : ToggleButton

9 , d i r e c t i o n C o n t r o l : : [ RadioButton ]

10 , powerControl : : [ RadioButton ]

(20)

Chapter 4 Graphical user interface

11 }

4.1.1 Construction

We define a straighforward constructor function for the gui controls.

1 newGuiControls = do

2 mainPanel < vBoxNew F a l s e 10

3 s t a t u s L a b e l < textViewNew

4 addrLabel < labelNew$Just$show 1

5 s p e e d A d j u s t < adjustmentNew 0 . 0 0 . 0 1 2 8 . 0 1 1 . 0 1 . 0

6 l i g h t B u t t o n < toggleButtonNewWithLabel ” L i g h t On/ O f f ”

7 forwardButton< radioButtonNewWithLabel$show Forward

8 backButton <

9 radioButtonNewWithLabelFromWidget forwardButton $show Backward

10 addrButtons < s e q u e n c e $map ( buttonNewWithLabel .show) [ 1 . . 2 1 ]

11 onButton < radioButtonNewWithLabel ” Power On”

12 o f f B u t t o n <

13 radioButtonNewWithLabelFromWidget onButton ” Power O f f ”

14 textViewSetWrapMode s t a t u s L a b e l WrapChar

15 w i d g e t S e t S i z e R e q u e s t s t a t u s L a b e l (1) 180

16 r e t u r n

17 G u i C o n t r o l s

18 { mainBox = mainPanel

19 , s t a t u s L a b e l = s t a t u s L a b e l

20 , add rLab el = addr Labe l

21 , s p e e d A d j u s t = s p e e d A d j u s t

22 , a d d r S e l e c t = addrButtons

23 , l i g h t B u t t o n = l i g h t B u t t o n

24 , d i r e c t i o n C o n t r o l = [ forwardButton , backButton ]

25 , powerControl = [ onButton , o f f B u t t o n ]

26 }

4.2 Updates

When in the global state a new current locomotive is set, the gui controls need to be updated. this can be achieved by use of the following function.

1 updateGUI Loco { l i d=l i d , s p e e d=sp , d i r e c t i o n=d i r , l i g h t= l i } g u i = do

2 i f ( Forward==d i r )

3 then t o g g l e B u t t o n S e t A c t i v e ( h e a d $ d i r e c t i o n C o n t r o l g u i ) True

4 e l s e t o g g l e B u t t o n S e t A c t i v e ( h e a d $ t a i l $ d i r e c t i o n C o n t r o l g u i ) True

5 a d j u s t m e n t S e t V a l u e ( s p e e d A d j u s t g u i ) $ f r o m I n t e g e r $ t o I n t e g e r sp

(21)

4.3 Layout

6 t o g g l e B u t t o n S e t A c t i v e ( l i g h t B u t t o n g u i ) l i

7 l a b e l S e t T e x t ( a ddrL abel g u i ) (show l i d )

4.3 Layout

This section the controls of the application GUI and put them together with some layout. Propably it would have been better to use the GUI builder tool glade in the first place rather than doing everything manually. However, here we go.

The first function is an auxilary function to create the layout for a list of radio buttons:

1 mkLayoutRadioButtons ( b1 : bs ) = do

2 mainbox < vBoxNew F a l s e 0

3 box1 < hBoxNew F a l s e 0

4 box2 < hBoxNew F a l s e 10

5 c o n t a i n e r S e t B o r d e r W i d t h box2 10

6 boxPackStart box1 box2 PackNatural 0

7 boxPackStart box2 b1 PackNatural 0

8 sequence$map ( \ b > boxPackStart box2 b PackNatural 0 ) bs

9 boxPackStart mainbox box1 PackNatural 0

10 r e t u r n mainbox

The next function creates a layout for the address selection buttons of the clients gui. They are placed in rows of three.

1 mkLayoutAddrSelect g u i = do

2 l e t b u t t o n s = a d d r S e l e c t g u i

3 l e t a d j = s p e e d A d j u s t g u i

4 l i n e s <s e q u e n c e $ t a k e (l e n g t h b u t t o n s ‘div‘ 3 ) $ r e p e a t hButtonBoxNew

5 sequence_

6 $ map ( \ ( bb , bs )> s e t bb [ c o n t a i n e r C h i l d := b | b < bs ] )

7 $ z i p l i n e s

8 $ splitNChunks (l e n g t h b u t t o n s ‘div‘ l e n g t h l i n e s) b u t t o n s

9 vbox < vButtonBoxNew

10 s e t vbox [ c o n t a i n e r C h i l d := l | l < l i n e s ]

11 r e t u r n vbox

The following function creates a layout for the speed control, light switch, direction

and the address selection.

(22)

Chapter 4 Graphical user interface

1 mkLayoutLocoGui g u i = do

2 l e t a d j 1 = s p e e d A d j u s t g u i

3 forwardBackwardButton < mkLayoutRadioButtons ( d i r e c t i o n C o n t r o l g u i )

4

5 l e t l i g h t B = l i g h t B u t t o n g u i

6

7 box1 < hBoxNew F a l s e 0

8 v s c < vScaleNew a d j 1

9 box2 < vBoxNew F a l s e 0

10 boxPackStart box1 box2 PackGrow 0

11

12 h s c 1 < hScaleNew a d j 1

13 boxPackStart box2 h s c 1 PackGrow 0

14

15 mainBox < vBoxNew F a l s e 10

16

17 addrLBox < hBoxNew F a l s e 10

18 l a b < l a b e l N e w $ J u s t ” Current Loco Address : ”

19 boxPackStart addrLBox l a b PackGrow 0

20 boxPackStart addrLBox ( addrL abe l g u i ) PackGrow 0

21 boxPackStart mainBox addrLBox PackGrow 0

22

23 boxPackStart mainBox forwardBackwardButton PackGrow 0

24 boxPackStart mainBox l i g h t B PackGrow 0

25

26 l S e l < l a b e l N e w $ J u s t ” Speed ”

27 boxPackStart mainBox l S e l PackGrow 0

28 boxPackStart mainBox box1 PackGrow 0

29

30 l S e l < l a b e l N e w $ J u s t ” Loco Address S e l e c t i o n ”

31 boxPackStart mainBox l S e l PackGrow 0

32 a d d r S e l e c t < mkLayoutAddrSelect g u i

33 boxPackStart mainBox a d d r S e l e c t PackGrow 0

34

35 r e t u r n mainBox

Putting everything together and adding the power control and the status display to the layout:

1 c r e a t e O v e r a l l L a y o u t g u i = do

2 l e t mainb = mainBox g u i

3

4 l e t o n O f f C o n t r o l = powerControl g u i

5 onOffButtons < mkLayoutRadioButtons o n O f f C o n t r o l

6

7 s t a t u s B o x < scrolledWindowNew Nothing Nothing

8 w i d g e t S e t S i z e R e q u e s t s t a t u s B o x (−1) 80

9 scrolledWindowAddWithViewport s t a t u s B o x ( s t a t u s L a b e l g u i )

10

(23)

4.4 Event Handler

11 boxPackStart mainb onOffButtons PackGrow 0

12

13 l o c o P a n e l <− mkLayoutLocoGui g u i

14 boxPackStart mainb l o c o P a n e l PackGrow 0

15 l S e l < l a b e l N e w $ J u s t ” R e c e i v e d Messages ”

16 boxPackStart mainb l S e l PackGrow 0

17 boxPackStart mainb s t a t u s B o x PackGrow 0

4.4 Event Handler

In this section we will add event handlers to the controls of the GUI.

The first function is a utility function, that adds event handlers to a list of pairs of buttons and events.

1 addEventsRadioButtons las@ ( ( b1 ,_) :_) = do

2 t o g g l e B u t t o n S e t A c t i v e b1 True

3 sequence_$map ( \ ( b , a )> onToggled b ( a >> r e t u r n ( ) ) ) l a s

Events for the buttons in the address selection control:

1 addEventAddrSelect g u i s t a t e sendF = do

2 l e t a d j = s p e e d A d j u s t g u i

3 sequence$map

4 ( \ b >

5 o n C l i c k e d b$ do

6 n r l < buttonGetLabel b

7 l e t nr = r e a d n r l

8 sendF $LAN_X_GET_LOCO_INFO nr

9 modifyMVar_ s t a t e (r e t u r n. s e l e c t L o c o nr )

10 s < readMVar s t a t e

11 l e t l o c o = c u r r e n t L o c o s

12 updateGUI l o c o g u i

13 )

14 ( a d d r S e l e c t g u i )

Events for further controls. First the event for the direction switch:

1 addGuiEvents g u i s t a t e send = do

2 l e t a d j 1 = s p e e d A d j u s t g u i

3 addEventsRadioButtons

4 $map ( \ x>(x , do

(24)

Chapter 4 Graphical user interface

5 l a b e l < buttonGetLabel x

6 l e t d i r = (r e a d l a b e l ) : : D i r e c t i o n

7 modifyMVar_ s t a t e (r e t u r n. s e t D i r e c t i o n d i r )

8 s < readMVar s t a t e

9 l e t l o c o = c u r r e n t L o c o s

10 a d j u s t m e n t S e t V a l u e a d j 1 0

11 send $LAN_X_SET_LOCO_DRIVE ( a d d r e s s l o c o ) 2 0 d i r

12 ) )

13 ( d i r e c t i o n C o n t r o l g u i )

Event for the light switch:

1 l e t l i g h t B = l i g h t B u t t o n g u i

2 o n C l i c k e d l i g h t B $ do

3 s < readMVar s t a t e

4 l e t l o c o = c u r r e n t L o c o s

5 a c t i v < t o g g l e B u t t o n G e t A c t i v e l i g h t B

6 l e t x = i f a c t i v then On e l s e O f f

7 modifyMVar_ s t a t e (r e t u r n. s e t L i g h t a c t i v )

8 send LAN_X_SET_LOCO_FUNCTION{ l o c I D=a d d r e s s l o c o , s w i t c h=x ,i n d e x=0}

9 r e t u r n ( )

Event for speed adjustment:

1 onValueChanged a d j 1 $ do

2 s < readMVar s t a t e

3 l e t l o c o = c u r r e n t L o c o s

4 v a l < adjustmentGetValue a d j 1

5 l e t v = (t r u n c a t e v a l ) : : Word8

6 modifyMVar_ s t a t e (r e t u r n. s e t S p e e d v )

7 send$LAN_X_SET_LOCO_DRIVE

8 ( a d d r e s s l o c o ) 2 v ( Z21 . S t a t e . d i r e c t i o n l o c o )

9 r e t u r n ( )

The event for the power switch:

1 addEventsRadioButtons$

2 z i p ( powerControl g u i )

3 [ send LAN_X_SET_TRACK_POWER_ON

4 , send LAN_X_SET_TRACK_POWER_OFF]

1 addEventAddrSelect g u i s t a t e send

(25)

4.5 Overall Window Creation

4.5 Overall Window Creation

Eventually we provide a function to build everything, add events and display it in a window.

1 createGuiWindow g u i s t a t e send = do

2 −− C r e a t e a new window

3 window < windowNew

4

5 −− S e t s t h e b o r d e r width o f t h e window .

6 s e t window [ c o n t a i n e r B o r d e r W i d t h := 10 ]

7

8 c r e a t e O v e r a l l L a y o u t g u i

9

10 −− s e t s t h e c o n t e n t s o f t h e window

11 s e t window [ c o n t a i n e r C h i l d := mainBox g u i ]

12

13 addGuiEvents g u i s t a t e send

14

15 r e t u r n window

(26)

Chapter 4 Graphical user interface

(27)

Chapter 5

Message handling

We are receiving messages from the Z21 control. Messages will notify contacts on curcuit tracks, new values for turn outs or locos. In this module we define means to program reaction to recieved messages.

1 module Z21 . M e s s a g e E v e n t L i s t e n e r where

2 import Z21 . P r o t o c o l l h i d i n g( l i g h t , d i r e c t i o n , s p e e d )

3 import q u a l i f i e d Z21 . P r o t o c o l l a s Z21 ( l i g h t , d i r e c t i o n , s p e e d )

4 import Z21 . S t a t e

5 import Z21 . Gui

6

7 import C o n t r o l .Monad ( f o r e v e r )

8 import C o n t r o l . Concurrent

9

10 import Gra phi cs . UI . Gtk

11

12 −−import Network . S o c k e t h i d i n g ( send , sendTo , recv , recvFrom )

13 import Network . S o c k e t . B y t e S t r i n g

The main type is a list of message handlers. A message handlers is basically a function, which takes a messages and results an (IO Bool) event. This is an IO action that results in an boolean value. The boolean value signifies, if the message was of interest and had been successfully processed, e.g. there might be a message handler which waits for contact on a certain circuit track. Only a message signifying contact on this track will result in an succesfull IO operation.

Every message handler has a unique number and a boolean flag. The flag signifies, if the message handler will only be used one time successfully.

The message listener type has the list of message handlers and a number, which will be the number of the next message handler. Thus we can provide unique numbers for message handlers.

1 type MessageHandler = (I n t e g e r ,Bool, Message > IO Bool)

2 type M e s s a g e L i s t e n e r = (I n t e g e r , [ MessageHandler ] )

(28)

Chapter 5 Message handling

The overall message listener will be a global state variable initialized with the empty handler list.

1 n e w E v e n t L i s t e n e r = newMVar ( ( 1 , [ ] ) : : M e s s a g e L i s t e n e r )

The main function for the global message listener will recieve the messages from some socket. It will process every message handler in he list. Afterwards every message handler which ended successful and has the flag will be deleted from the list.

1 r e c e i v e M e s s a g e s e v e n t L i s t e n e r s o c k e t = f o r e v e r $ do

2 message <r e c v s o c k e t 1024

3 l e t msg = readMessage message

4 p r i n t msg

5 ( nr , l i s t e n e r )< readMVar e v e n t L i s t e n e r

6 r s <−s e q u e n c e $ map ( \ ( nr , _, f ) > f msg ) l i s t e n e r

7 l e t t o D e l e t e = f i l t e r ( \ ( ( nr , oneShot ,_) , s h o t )>oneShot && s h o t )

8 $ z i p ( l i s t e n e r ) r s

9 sequence_

10 (map ( \ ( ( nr , _,_) ,_)>r e m o v e L i s t e n e r e v e n t L i s t e n e r nr ) t o D e l e t e )

The function above will be started in an own thread.

1 s t a r t E v e n t L i s t e n e r l i s t e n e r s o c k e t =

2 f o r k I O $ r e c e i v e M e s s a g e s l i s t e n e r s o c k e t

We provide two functions to add new message handlers to the global message lis- tener. The result of the action is the number of the added handler.

Two versions are provided. One for handlers which will be removed after the first successful reaction, one for handlers that stay in the list.

1 a d d L i s t e n e r = addListenerAux F a l s e

2 addOneTimeListener = addListenerAux True

3

4 addListenerAux oneTime e v e n t L i s t e n e r f = do

5 modifyMVar_ e v e n t L i s t e n e r

6 ( \ ( nr , f s )>r e t u r n ( nr +1 ,( nr , oneTime , f ) : f s ) )

7 ( nr ,_)< readMVar e v e n t L i s t e n e r

8 r e t u r n ( nr1)

(29)

5.1 Special handlers

Of course it is possible to remove handlers again:

1 r e m o v e L i s t e n e r e v e n t L i s t e n e r nr = do

2 (_, l i s t e n e r )< readMVar e v e n t L i s t e n e r

3 modifyMVar_

4 e v e n t L i s t e n e r

5 ( \ ( nmr , f s ) > r e t u r n ( nmr , f i l t e r ( \ ( n , _,_) > not ( n==nr ) ) f s ) )

5.1 Special handlers

In this paragraph we define two general message handlers.

The first one updates the global state. Furthermore it updates the view of the global state. Since the handler functions are not evaluated in the gui thread we capsule ev- ery gui functionality within the call of the gtk2hs standard function postGUIAsync.

1 p r o c e s s M e s s a g e g u i s t a t e send

2 LAN_X_LOCO_INFO{ l o c I D=id, Z21 . d i r e c t i o n=d i r , Z21 . s p e e d=sp , Z21 . l i g h t=l }

3 = do

4 modifyMVar_ s t a t e $ r e t u r n . r e p l a c e N o n A c t i v e L o c o

5 ( newLoco i d)

6 { s p e e d=sp , d i r e c t i o n=d i r , l i g h t=l }

7 r e t u r n True

8 p r o c e s s M e s s a g e g u i s t a t e send LAN_X_BC_TRACK_POWER_ON = do

9 p o s t G U I A s y n c $ t o g g l e B u t t o n S e t A c t i v e ( head$powerControl g u i ) True

10 r e t u r n True

11 p r o c e s s M e s s a g e g u i s t a t e send LAN_X_BC_TRACK_POWER_OFF = do

12 p o s t G U I A s y n c $ t o g g l e B u t t o n S e t A c t i v e ( h e a d $ t a i l $ p o w e r C o n t r o l g u i ) True

13 r e t u r n True

14 p r o c e s s M e s s a g e _ _ _ _ = r e t u r n F a l s e

Another function that will be evaluated whenever a message is received is solely for logging purposes. It will display the message on the status label of the GUI.

Furthermore the state of the current locomotive is printed to the console.

1 l o g g i n g g u i s t a t e msg = do

2 postGUIAsync g u i S t u f f

3 s<readMVar s t a t e

4 r e t u r n True

5 where

6 g u i S t u f f = do

7 t e x t V i e w S e t E d i t a b l e ( s t a t u s L a b e l g u i ) F a l s e

8 b u f f e r <t e x t B u f f e r N e w Nothing

9 t e x t B u f f e r I n s e r t I n t e r a c t i v e A t C u r s o r b u f f e r (show msg ) True

(30)

Chapter 5 Message handling

10 t e x t V i e w S e t B u f f e r ( s t a t u s L a b e l g u i ) b u f f e r

(31)

Chapter 6

Automatic Commuting

A typical usecase for a modell railway display is a train commuting between two stops. In German there is the nice word: Pendelzugautomatik. To put this into realization we need some contacts that signifies when a train reaches a certain point. We can use circuit tracks for this purpose.

This module implements some means to program a Pendelzugautomatik. It provides a function, which will start a Pendelzugautomatik and a GUI component, to start a commuting train.

1 module Z21 . Commuting where

2

3 import Z21 . S t a t e

4 import Z21 . P r o t o c o l l

5 import Z21 . M e s s a g e E v e n t L i s t e n e r

6

7 import Data .Maybe

8

9 import Text .Read

10

11 import C o n t r o l . Concurrent . MVar

12 import C o n t r o l . Concurrent . Timer

13 import C o n t r o l . Concurrent . Suspend . L i f t e d

14

15 import Data . B i t s

16

17 import Gra phi cs . UI . Gtk

The Z21 signifies contact on a circuit track with a LAN_RMBUS_DATACHANGED mes- sage. It uses the so called R-Bus for feedback modules. The circuit tracks are grouped, such that a contact is represented by a pair of numbers: the group and the address.

1 type Contact = (Int ,I n t)

(32)

Chapter 6 Automatic Commuting

To start a Pendelzugautomatik we need basic information between which stops, which loco and the idle time at each stop. Furthermore we need global information:

the event listeners and the state of the control unit. And of course the communica- tion function with the z21 control unit.

The result is an IO action which returns the number of the event listener, that controls the Pendelzugautomatik. Thus we get the following type

1

.

1 startCommuting

2 : : Contact −− f i r s t c o n t a c t

3 > Contact −− s e c o n d c o n t a c t

4 > I n t −− l o c o i d

5 > I n t −− i d l e time

6 > MVar M e s s a g e L i s t e n e r −− e v e n t l i s t e n e r s

7 > MVar S t a t e −− g l o b a l s t a t e

8 > ( Message > IO a1 ) −− communication with Z21

9 > IO I n t e g e r −− r e t u r n t h e number o f t h e e v e n t l i s t e n e r

The function startCommuting is basically implemented by a new event listener function. This function will evaluate LAN_RMBUS_DATACHANGED messages. In order to recieve these messages from the Z21 control unit, we need to send an appropiate LAN_SET_BROADCASTFLAGS message.

We assume that the locomotive is somewhere between the two stops. The locomotive will be started in one arbitrary direction.

A further state variable is used to remember which was the last stop the loco activated. It is initialized with the illegal contact (-1,-1).

1 startCommuting l e f t C r i g h t C l o c i d d e l a y e v e n t L i s t e n e r s t a t e send = do

2 l a s t C o n t a c t < newMVar (1 ,1)

3 send LAN_SET_BROADCASTFLAGS

4 { g e n e r a l=True, r bu s=True, s y s t e m S t a t e=F a l s e}

5

6 nr < a d d L i s t e n e r e v e n t L i s t e n e r ( e v a l l a s t C o n t a c t )

7

8 send (LAN_X_SET_LOCO_DRIVE l o c i d 2 6 Forward )

9

10 modifyMVar_ s t a t e ( \ s > r e t u r n $ s e t D i r e c t i o n O f L o c o l o c i d Forward s )

11 r e t u r n nr

The main work is done by the event listener function. It has two arguments. The state variable, which contains the circuit track that has been contacted the last time. The second argument is the message to be processed.

1The actual derived type is more general, but for a clearer understanding it has been simplified a bit.

(33)

First of all the function needs to analyse the incoming message. Which contact is active. Wen need to have a closer look at the single bytes of the message.

2

The first local definitions create a list of all active contacts. As a matter of fact the message may contain information on several activ contacts. Currently the imple- mentation neglects simultanious contacts in different groups. This is simply duw to the fact that I have not enough hardware to test several groups.

1 where

2 e v a l l a s t C o n t a c t (LAN_RMBUS_DATACHANGED ( g i : g s ) ) = do

3 l e t adder = i f g i==0 then 0 e l s e 10

4 l e t numbered=f i l t e r ( \ (_, e n t r y )> e n t r y /=0) $ z i p [ 1 . . ] g s

5 i f (n u l l numbered ) then r e t u r n F a l s e e l s e do

6 l e t changedGroup = adder+f s t(head numbered )

7 l e t groupVal = snd(head numbered )

8 l e t ad dr s = f i l t e r ( \ (_, code )> code == groupVal . & . code )

9 $ z i p

10 [ ( 1 : : I n t) . . ]

11 [ 0 x01 , 0 x02 , 0 x04 , 0 x08 , 0 x10 , 0 x20 , 0 x40 , 0 x80 ]

12 i f (n u l l ad drs ) then r e t u r n F a l s e e l s e do

13 l e t newContacts = map ( \ ( x ,_)>(changedGroup , x ) ) a d d r s

First of all we check if the last contact we reacted to is still active or again active. If this is the case the locomotive obviously has not moved very much and still triggers the contact of the same stopping. Then we do not react at all.

1 o l d C o n t a c t < readMVar l a s t C o n t a c t

2 i f (elem o l d C o n t a c t newContacts ) then r e t u r n F a l s e e l s e do

If none of the contacts at the two stoppings is active then no reaction is necessary.

1 i f not (elem l e f t C newContacts | | elem r i g h t C newContacts )

2 then r e t u r n F a l s e e l s e do

Eventually at this point we know that the train reached the other stopping. No several things are to be done. Stop the train. Modify the global state. After the specified time of delay start the train with the switched direction. The wait is done with the timer function: oneShotTimer.

2It would have been more consequent to have done this in the moduleProtocolland provided more structured information with the constructorLAN_RMBUS_DATACHANGED.

(34)

Chapter 6 Automatic Commuting

1 l e t newContact = i f elem l e f t C newContacts

2 then l e f t C

3 e l s e r i g h t C

4

5 modifyMVar_ l a s t C o n t a c t ( \_>r e t u r n newContact )

6

7 s < readMVar s t a t e

8 l e t d i r = s w i t c h D i r e c t i o n $ g e t D i r e c t i o n O f L o c o l o c i d s

9 modifyMVar_ s t a t e ( \ s > r e t u r n $ s e t D i r e c t i o n O f L o c o l o c i d d i r s )

10

11 send (LAN_X_SET_LOCO_DRIVE l o c i d 2 0 d i r )

12

13 oneShotTimer

14 ( (send$LAN_X_SET_LOCO_DRIVE l o c i d 2 6 d i r ) >>r e t u r n ( ) )

15 ( sDelay $ f r o m I n t e g r a l d e l a y )

16 r e t u r n True

We are only interested in LAN_RMBUS_DATACHANGED messages. For all other message no reaction is necessary.

1 e v a l _ _ = r e t u r n F a l s e

Since the Pendelzugautomatik is controlled by a single event listener function the Pendelzugautomatik can be stopped by removing this listener from the global lis- tener queue.

1 stopCommunting l i s t e n I d l o c i d e v e n t L i s t e n e r send = do

2 send (LAN_X_SET_LOCO_DRIVE l o c i d 2 0 Forward )

3 r e m o v e L i s t e n e r e v e n t L i s t e n e r l i s t e n I d

6.1 GUI

We provide a GUI component for the control of commuting trains. We apply the same pattern as in the module Z21.Gui. All relevant controls are collected in one type.

1 data −− BoxClass a =>

2 CommutingGui a = CommutingGui

3 { mainPanel : : VBox

4 , addrEntry : : Entry

(35)

6.1 GUI

5 , f s t C i r c u i t G r o u p : : Entry

6 , f s t C i r c u i t E n t r y : : Entry

7 , s n d C i r c u i t E n t r y : : Entry

8 , s n d C i r c u i t G r o u p : : Entry

9 , d e l a y E n t r y : : Entry

10 , s t a r t S t o p C o n t r o l : : ToggleButton

11 }

A constructor function is provided.

1 newCommutingGui = do

2 mainPanel < vBoxNew F a l s e 10

3 addEntry < entryNew

4 f s t C i r c u i t E n t r y < entryNew

5 e n t r y S e t T e x t f s t C i r c u i t E n t r y ” 1 ”

6 s n d C i r c u i t E n t r y < entryNew

7 e n t r y S e t T e x t s n d C i r c u i t E n t r y ” 2 ”

8 f s t C i r c u i t G r o u p < entryNew

9 e n t r y S e t T e x t f s t C i r c u i t G r o u p ” 1 ”

10 s n d C i r c u i t G r o u p < entryNew

11 e n t r y S e t T e x t s n d C i r c u i t G r o u p ” 1 ”

12 d e l a y E n t r y < entryNew

13 e n t r y S e t T e x t d e l a y E n t r y ” 5 ”

14 s t a r t S t o p B u t t o n < toggleButtonNewWithLabel ” S t a r t / Stop ”

15 r e t u r n

16 CommutingGui

17 { mainPanel = mainPanel

18 , addrEntry = addEntry

19 , f s t C i r c u i t E n t r y = f s t C i r c u i t E n t r y

20 , s n d C i r c u i t E n t r y = s n d C i r c u i t E n t r y

21 , f s t C i r c u i t G r o u p = f s t C i r c u i t G r o u p

22 , s n d C i r c u i t G r o u p = s n d C i r c u i t G r o u p

23 , d e l a y E n t r y = d e l a y E n t r y

24 , s t a r t S t o p C o n t r o l = s t a r t S t o p B u t t o n

25 }

6.1.1 Layout

A layout is added to the components.

1 mkLayoutCommutingGui g u i = do

2 lokP < hBoxNew F a l s e 10

3 l o k L a b e l < l a b e l N e w $ J u s t ” L o k a d r e s s e ”

4 boxPackStart lokP l o k L a b e l PackNatural 0

5 boxPackStart lokP ( addrEntry g u i ) PackNatural 0

6 boxPackStart ( mainPanel g u i ) lokP PackNatural 0

(36)

Chapter 6 Automatic Commuting

7 f s t L a b e l < l a b e l N e w $ J u s t ” e r s t e r Kontakt ( Gruppe , Nr ) ”

8 boxPackStart ( mainPanel g u i ) f s t L a b e l PackNatural 0

9 f s t P < hBoxNew F a l s e 10

10 boxPackStart f s t P ( f s t C i r c u i t G r o u p g u i ) PackNatural 0

11 boxPackStart f s t P ( f s t C i r c u i t E n t r y g u i ) PackNatural 0

12 boxPackStart ( mainPanel g u i ) f s t P PackNatural 0

13 sndLabel < l a b e l N e w $ J u s t ” z w e i t e r Kontakt ( Gruppe , Nr ) ”

14 boxPackStart ( mainPanel g u i ) sndLabel PackNatural 0

15 sndP < hBoxNew F a l s e 10

16 boxPackStart sndP ( s n d C i r c u i t G r o u p g u i ) PackNatural 0

17 boxPackStart sndP ( s n d C i r c u i t E n t r y g u i ) PackNatural 0

18 boxPackStart ( mainPanel g u i ) sndP PackNatural 0

19 delayP < hBoxNew F a l s e 10

20 d e l a y L a b e l < l a b e l N e w $ J u s t ” W a r t e z e i t ”

21 boxPackStart delayP d e l a y L a b e l PackNatural 0

22 boxPackStart delayP ( d e l a y E n t r y g u i ) PackNatural 0

23 boxPackStart ( mainPanel g u i ) delayP PackNatural 0

24 boxPackStart ( mainPanel g u i ) ( s t a r t S t o p C o n t r o l g u i ) PackNatural 0

6.1.2 Events

And eventually we add event listeners to the controls. Internally we keep a state variable for the number of the listener that is active. It is initialized with the illegal number -1.

1 addCommutingGuiEvents g u i e v e n t L i s t e n e r s t a t e send = do

2 l e t s t a r t S t o p B = s t a r t S t o p C o n t r o l g u i

3 l i s t e n e r N r < newMVar (1 : :I n t e g e r)

4 addrS < entryGetText ( addrEntry g u i )

User Input

Whenever the start/stop button is clicked, we first have a look if the button is active.

1 s t a r t S t o p B ‘ onCl ick ed ‘ do

2 mode < t o g g l e B u t t o n G e t A c t i v e s t a r t S t o p B

If this is not the case then we stop the running commuting train.

(37)

6.1 GUI

1 i f not mode then do

2 nr < readMVar l i s t e n e r N r

3 stopCommunting nr (r e a d addrS ) e v e n t L i s t e n e r send

4 e l s e do

Validation of User Input

Otherwise we can read and validate the user input. For validation of the user input we use the standard function readMaybe. Since the type Maybe is an instance of Monad we can use the do-notation for validation of the user input. If the user input cannot be evaluated we return with no action at all.

1 f s t C S < entryGetText ( f s t C i r c u i t E n t r y g u i )

2 sndCS < entryGetText ( s n d C i r c u i t E n t r y g u i )

3 fstGS < entryGetText ( f s t C i r c u i t G r o u p g u i )

4 sndGS < entryGetText ( s n d C i r c u i t G r o u p g u i )

5 delayS< entryGetText ( d e l a y E n t r y g u i )

6

7 l e t i n p u t V a l u e s =

8 do

9 a < ( readMaybe addrS ) : :Maybe I n t

10 fC < ( readMaybe f s t C S ) : :Maybe I n t

11 sC < ( readMaybe sndCS ) : :Maybe I n t

12 fG < ( readMaybe fstGS ) : :Maybe I n t

13 sG < ( readMaybe sndGS ) : :Maybe I n t

14 d < ( readMaybe d e l a y S ) : :Maybe I n t

15 r e t u r n ( a , fG , fC , sG , sC , d )

16 i f (i s N o t h i n g i n p u t V a l u e s ) then r e t u r n ( ) e l s e do

Otherwise the user input can be used to start a Pendelzugautomatik.

1 l e t (J u s t ( addr , fstG , fstC , sndG , sndC , d e l a y ) ) = i n p u t V a l u e s

2 nr < startCommuting ( fstG , f s t C ) ( sndG , sndC ) addr d e l a y

3 e v e n t L i s t e n e r s t a t e send

4 modifyMVar_ l i s t e n e r N r ( \_ > r e t u r n nr )

(38)

Chapter 6 Automatic Commuting

Referenzen

ÄHNLICHE DOKUMENTE

Set breakpoint at address. The breakpoint is executed count-1 times before causing a stop. Each time the breakpoint is encountered, the command c is executed. If this

The civil societies of the eastern neighbours in particular, see European standards of human rights and democracy as the model.. Moreover, the EU’s neighbourhood policy

For many Muslims, the self-declared Caliph of ISIS/Daesh is in a similar position – he has no legitimacy to make these claims, is not behaving as a Caliph should, and is

Professor at Nanyang Technological University in Singapore, explains that “Not only has [the Andaman and Nicobar Joint Command] failed to usher in more joint commands, but the

NATO can lead the way for cyber-security contracting by considering the risks associated with blurred lines between private contractors (non-combatants) and military

DOD has at various points said that theater cyber will be “under the command and control of which- ever combatant command to which they are assigned,” will be “aligned under one

Or should the United States, in cooperation with like-minded partners, develop a comprehensive regional strategy to prevent the Sahel from becoming the center of what the UN

With the goal of standardizing practice, in 1994, BILC initiated Professional Seminars for NATO and PfP nations, covering themes such as Co-operation in Language Training