git @ Cat's Eye Technologies Decoy / master junk / thencemuffin2.scm
master

Tree @master (Download .tar.gz)

thencemuffin2.scm @master — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
; SPDX-FileCopyrightText: Copyright (c) 2023-2024 Chris Pressey, Cat's Eye Technologies.
; This work is distributed under a 2-clause BSD license. For more information, see:
; SPDX-License-Identifier: LicenseRef-BSD-2-Clause-X-Decoy

;/*
; * Thencemuffin2: a just plain inexcusable esolang
; * This version composed to show how unpleasant mixing
; * javaScriptCamelCasing and scheme-hyphenated-casing is
; */

(define module "thencemuffin2")

(import-from "stdenv" (list or not >= equal? string-ref length))

(import-from "rux-rolli" (
    newComposite
    getTextChild
    getPlayfieldChild
    getStackChild

    newPlayfield
    setCursor
    put
    moveCursor

    newCursor

    newRange

    newText
    getString
    moveRange
    getRanges

    newStack
    push
    pop

    nextWith
    haltWith
    inputWith
))

(define index list)  ; FIXME
(define get-index list)  ; FIXME

(define load (lambda (program-text)
  (newComposite (list
    (newText program-text (list (newRange 0 1)))
    (put 0 0 "X" (setCursor "IP" (newCursor 0 0 1 0) (newPlayfield)))
    (newStack (list))
  ))
))

(define next (lambda (configuration)
  (let* ((text  (getTextChild configuration 0))
         (pf    (getPlayfieldChild configuration 1))
         (stack (getStackChild configuration 2)))
    (if (or (not text) (not pf) (not stack))
      (haltWith configuration)
      (let* ((range (index 0 (getRanges text))))
        (if (>= (get-index range) (length (getString text)))
          (haltWith configuration)
          (let* ((next-text (moveRange text 0 1))
                 (char (string-ref (getString text) (get-index range))))
            (if (equal? char "I")
              (inputWith (newComposite (list next-text pf (push "*" stack))))
              (let* ((next-stack
                       (if (equal? char "S")
                         (if (pop stack) (pop stack) stack)
                         (push "A" stack)))
                   (next-pf (moveCursor "IP" 1 0 (put 2 1 char pf))))
                (nextWith (newComposite (list next-text next-pf next-stack))))))))))
))

(define recv (lambda (configuration input)
  (let* ((text  (getTextChild configuration 0))
         (pf    (getPlayfieldChild configuration 1))
         (stack (getStackChild configuration 2)))
    (if (or (not text) (not pf) (not stack))
      (haltWith configuration)
      (nextWith (newComposite (list text pf (push stack input))))))
))