docs/music/tools/fault-line-composition-audit.sgl

1#!/usr/bin/env sigil

2;;; Review the new form, shared passages and actual game-loop boundaries.

3(import (sigil list))

4(load (path (script-dir) "lib/core.sgl"))

5(load (path (script-dir) "lib/album-arrangement.sgl"))

6(import (crash soundtrack tools)

7 (crash soundtrack album arrangement))

8(initialize (path (script-dir) "../../.."))

9

10(define (musical row cell)

11 (and (not (equal? (cdr cell) '("..." 0 0 "000"))) cell))

12

13(cli "fault-line-composition-audit" (script-args) '()

14 (lambda (options)

15 (let* ((source (read-score

16 (path (root) "docs/music/alternates/fault-line-bass-lock-vii/fault-line-after.cts")))

17 (album (read-score (path (root) "docs/music/album/fault-line.cts")))

18 (game (read-score (path (root) "docs/music/alternates/fault-line-game.cts"))))

19 (each pair '((3 1) (8 2) (9 3))

20 (check (equal? (set-field (pattern album (car pair)) id: 0)

21 (set-field (pattern source (cadr pair)) id: 0))

22 "Approved riff, entrance or solo changed" pair))

23 (each old (cdr (child source 'instruments))

24 (check (equal? old

25 (list-find (lambda (i) (= (field i id:) (field old id:)))

26 (cdr (child album 'instruments))))

27 "Approved patch changed" (field old id:)))

28 (check (equal? (child game 'instruments) (child album 'instruments))

29 "Game and album banks differ")

30 (check (equal? (child game 'bus) (child album 'bus)) "Game and album buses differ")

31 (each pair '((0 1) (1 2) (2 8) (3 3) (4 4) (5 9))

32 (check (equal? (set-field (transform (pattern game (car pair)) musical) id: 0)

33 (set-field (transform (pattern album (cadr pair)) musical) id: 0))

34 "Shared game and album phrase differs" pair))

35 (let ((jumps '()))

36 (each p (cdr (child game 'patterns))

37 (each row (skip p 5)

38 (each cell (cddr row)

39 (when (starts-with? (list-ref cell 4) "B")

40 (set! jumps

41 (append jumps

42 (list (list (field p id:) (cadr row) (list-ref cell 4)))))))))

43 (check (equal? jumps '((1 255 "B00") (5 255 "B03")))

44 "Wrong calm or tense loop destination" jumps))

45 (ensure-directory (option-ref options 'output))

46 (write-json-file (path (option-ref options 'output) "composition-checks.json")

47 (dict approved_riff_transition_solo_preserved: #t

48 original_twelve_patches_preserved: #t

49 shared_game_album_phrases: 6

50 shared_bank_and_bus: #t

51 calm_orders: (array 0 1)

52 fill_order: 2 tense_orders: (array 3 4 5)

53 album_bars: 96 game_cycle_bars: 42))

54 (println "Shared composition, accepted sound and calm/tense loop checks passed."))))