; 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
;/*
; * Thencemuffin: a just plain inexcusable esolang
; */
(define module "thencemuffin")
(import-from "stdenv" (list or not >= equal? string-ref length))
(import-from "rux-rolli" (
(newComposite as new-composite)
(getTextChild as get-text-child)
(getPlayfieldChild as get-playfield-child)
(getStackChild as get-stack-child)
(newPlayfield as new-playfield)
(setCursor as set-cursor)
put
(moveCursor as move-cursor)
(newRange as new-range)
(getRangeIndex as get-range-index)
(newCursor as new-cursor)
(newText as new-text)
(getString as get-string)
(getRanges as get-ranges)
(moveRange as move-range)
(newStack as new-stack)
push
pop
(nextWith as next-with)
(haltWith as halt-with)
(inputWith as input-with)
))
(define array-index list) ; FIXME (import-from "js-interop" (array-index))
(define load (lambda (program-text)
(new-composite (list
(new-text program-text (list (new-range 0 1)))
(put 0 0 "X" (set-cursor "IP" (new-cursor 0 0 1 0) (new-playfield)))
(new-stack (list))
))
))
(define next (lambda (configuration)
(let* ((text (get-text-child configuration 0))
(pf (get-playfield-child configuration 1))
(stack (get-stack-child configuration 2)))
(if (or (not text) (not pf) (not stack))
(halt-with configuration)
(let* ((range (array-index 0 (get-ranges text))))
(if (>= (get-range-index range) (length (get-string text)))
(halt-with configuration)
(let* ((next-text (move-range text 0 1))
(char (string-ref (get-string text) (get-range-index range))))
(if (equal? char "I")
(input-with (new-composite (list next-text pf (push "*" stack))))
(let* ((next-stack
(if (equal? char "S")
(if (pop stack) (pop stack) stack)
(push "A" stack)))
(next-pf (move-cursor "IP" 1 0 (put 2 1 char pf))))
(next-with (new-composite (list next-text next-pf next-stack))))))))))
))
(define recv (lambda (configuration input)
(let* ((text (get-text-child configuration 0))
(pf (get-playfield-child configuration 1))
(stack (get-stack-child configuration 2)))
(if (or (not text) (not pf) (not stack))
(halt-with configuration)
(next-with (new-composite (list text pf (push stack input))))))
))