On Wed, Jan 19, 2022 at 04:14:20PM +0100, Alexander Burger wrote:
> talks like last time, we could have a look at the new Discrete-Event 
> Simulation
> functions in @lib/simul.l (released in Pil21 yesterday). I prepared simple 
> demos
> (a modified version of the dining philosophers, and funny maze crawlers).

If you like to experiment with it: I attach the sources here.

☺/ A!ex
# 18jan22 Software Lab. Alexander Burger
# Dining Philosophers
# pil @lib/simul.l --symbols simul dining.l +

(de now (Str)
   (prinl (tim$ (* 60 *Time)) " " (co) " " Str) )

(de dining (Left Right)
   (loop
      (now "thinking")
      (pause (rand 180 240))
      (now "hungry")
      (until (nor (val Left) (val Right))
         (pause (rand 1 5)) )
      (set Left (set Right (co)))
      (now "eating")
      (pause 20)
      (set Left (set Right NIL)) ) )

'(de dining (Left Right)
   (loop
      (now "thinking")
      (pause (rand 180 240))
      (now "hungry")
      (until (nor (val Left) (val Right))
         (pause (rand 1 5)) )
      (set Left (set Right (co)))
      (now "eating")
      (pause 20)
      (set Left (set Right NIL))
      (now "sleeping")
      (pause 'morning)
      (now "get up") ) )

'(de dining (Left Right Co)
   (loop
      (now "thinking")
      (T (pause (rand 180 240)))
      (now "hungry")
      (and Co (wake Co T))
      (T
         (loop
            (NIL (or (val Left) (val Right)))
            (T (pause (rand 1 5)) T) ) )
      (set Left (set Right (co)))
      (now "eating")
      (T (pause 20))
      (set Left (set Right NIL)) )
   (now "EXIT") )

(co 'Aristotle
   (dining '*ForkA '*ForkB) )
(co 'Kant
   (dining '*ForkB '*ForkC) )
(co 'Spinoza
   (dining '*ForkC '*ForkD) )
(co 'Marx
   (dining '*ForkD '*ForkE) )
(co 'Russell
   (dining '*ForkE '*ForkA) )
# 19jan22 Software Lab. Alexander Burger
# pil maze.l -maze~main -go +

(load "@lib/simul.l")

(symbols 'maze 'simul 'pico)

(on *Rt)

(local) (*DX *DY *Grid crawl main go)

(setq *DX 10  *DY 22  *Grid (grid *DX *DY))

(de crawl (Start)
   (catch 'stop
      (while
         (with (get *Grid (rand 1 *DX) (rand 1 *DY))
            (unless (or (== Start This) (: co) (: goal))
               (=: goal (co))
               (finally (=: goal NIL)
                  (let Path NIL
                     (recur (This Path)
                        (cond
                           ((== This Start)
                              (=: co (co))
                              (pause 500)
                              This )
                           ((not (memq This Path))
                              (push 'Path This)
                              (when
                                 (or
                                    (and (: west) (recurse @ Path))
                                    (and (: east) (recurse @ Path))
                                    (and (: south) (recurse @ Path))
                                    (and (: north) (recurse @ Path)) )
                                 (put @ 'co NIL)
                                 (when (: co)
                                    (wake @ (throw 'stop)) )
                                 (=: co (co))
                                 (pause 500)
                                 This ) ) ) ) ) )
               (setq Start This) )
            *Next ) ) ) )

(de main ()
   (symbols '(maze simul pico))
   (let Fld (get *Grid (rand 1 *DX) (rand 1 *DY))
      (recur (Fld)
         (for Dir (shuffle '((west . east) (east . west) (south . north) (north 
. south)))
            (with ((car Dir) Fld)
               (unless (or (: west) (: east) (: south) (: north))
                  (put Fld (car Dir) This)
                  (put This (cdr Dir) Fld)
                  (recurse This) ) ) ) ) )
   (for Col *Grid
      (for This Col
         (set This
            (cons
               (cons (: west) (: east))
               (cons (: south) (: north)) ) ) ) ) )

(de go ()
   (co 'A (crawl 'a1))
   (co 'B (crawl (get *Grid 1 (/ *DY 2))))
   (co 'C (crawl (get *Grid 1 *DY)))
   (co 'D (crawl (get *Grid (/ *DX 2) *DY)))
   (co 'E (crawl (get *Grid *DX *DY)))
   (co 'F (crawl (get *Grid *DX (/ *DY 2))))
   (co 'G (crawl (get *Grid *DX 1)))
   (co 'H (crawl (get *Grid (/ *DX 2) 1)))
   (prin "^[[?1049h")  # Screen 2
   (prin "^[[?25l")  # Hide cursor
   (finally (prin "^[[?1049l" "^[[?25h")  # Screen 1, show cursor
      (while *Next
         (prin "^[[" 1 ";" 1 "H")  # cup
         (disp *Grid 0
            '((This)
               (cond
                  ((: co) (pack "<" @ ">"))
                  ((: goal) (pack " " @ " "))
                  (T "   ") ) ) )
         (des) )
      (key) ) )

Reply via email to