Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #135234

Re: Back & Forth - It still sounds MID.. [7b]

Show all headers | View raw

On 11-07-2026 17:09, albert@SPENARNC.XS4ALL.NL wrote:
> Hans Bezemer <the.beez.speaks@gmail.com> wrote:
>> Now on YT:  https://youtu.be/ExDbY0X7Cvg
>>
>> Hans Bezemer
> I hate that you don't mention what it is all about.
> It is about midi. It invites me to type ExDbYo(or 0) in the newsreader
> cause the newsreader don't support cut and place. So I followed
> up, my editor does it better.
> We are at it, This is the rosetta challenge to play a scale.
> A regular speaker required! MAKE-ACCESSABLE is not needed for MSDOS.
> In linux you want XOS generic OS access, e.g. in ciforth.
> 
> ---------------------------------------
> "$-PREFIX" WANTED  "-scripting-" WANTED
> : MAKE-ACCESSABLE   ( n-) 1 1 $65 XOS
>     DUP IF ." You cannot access i/o ports, become root" CR THROW THEN ;
>     : MAKE-SPEAKER-ACCESSABLE ( - )
>     $42 MAKE-ACCESSABLE   $43 MAKE-ACCESSABLE   $61 MAKE-ACCESSABLE ;
>     : SET-FREQUENCY  ( n - )  $B6 $43 PC!   DUP $42 PC!   8 RSHIFT $42 PC! ;
>     : SPEAKER-ON  ( - )  $61 PC@    3  OR $61 PC! ;
>     : SILENT-SPEAKER  ( -) $61 PC@  $FC AND $61 PC! ;
>     : secunde 17843 18904 */ ;
>     CREATE _notes   35613 ( C2) 12 0 DO DUP , secunde LOOP DROP
>     : >timing    ( n - n) 24 - 12 /MOD SWAP   CELLS _notes + @   SWAP RSHIFT ;
>     : NOTE-ON  ( n-)  >timing SET-FREQUENCY SPEAKER-ON ;
>     : NOTE-OFF ( n-)  DROP SILENT-SPEAKER ;
>     : PLAY-NOTE ( n n -)  OVER NOTE-ON MS NOTE-OFF ;
>     : .. ( n - ) 1000 PLAY-NOTE ;
>     \ Play a scale starting at the keyhole c.
>     : PLAY-SCALE
>     \ c'  d'    e'    f'    g'    a'    b'    c''
>     60 .. 62 .. 64 .. 65 .. 67 .. 69 .. 71 .. 72 ..
>     3000 MS ;
>     MAKE-SPEAKER-ACCESSABLE PLAY-SCALE
> ---------------------------------------
> 
> The same scale played on mswindows. (Assuming WINMM.DLL is present
> in SYSTEM32. a multimedia library.)
> openmidi sendmidi closemidi are wrappers around dll calls.
> They are slightly more than wrappers, because if you
> do
>      wina -c midi.frt
> a midi.exe is generated that you can transport accross
> windows systems (i.e. no Forth system needs to be present).
> 
> ---------------------------------------
> \ $Id: midi.frt,v 1.7 2015/04/15 02:04:17 albert Exp albert $
> \ Copyright (2012): Albert van der Horst {by GNU Public License}
> \ Uses MIDI facility to play a simple melody.
> \ vrij naar Jones jonesforth
> 
> WANT sendmidi    ( and openmidi closemid )
> WANT CASE-INSENSITIVE     CASE-INSENSITIVE
> 1 CONSTANT 'Grand_Piano'
> 
> VARIABLE instrument
> 
> : midi-errors
> "
>        2001 : Failed to open MIDI output device
>        2002 : Failed to close MIDI output device
>        2003 : Failed to send to MIDI output device
> " TYPE ;
> 
> : -i   SHIFT-ARGS 1 ARG[] EVALUATE instrument ! SHIFT-ARGS ;
> 
> : -h midi-errors
> "
> -h this help
> -i <instr> : install instrument to play on
> " ETYPE
> BYE ;
> 
> HEX
> \ Send a midi start message for NOTE
> : StartNote 8 LSHIFT 7F0090 OR sendmidi ;
> 
> \ Send a midi stop message for NOTE
> : StopNote 8 LSHIFT 80 OR sendmidi ;
> 
> \ Send a midi select message for VOICE
> : SetInstrument 8 LSHIFT 7F00C0 OR sendmidi ;
> DECIMAL
> 
> \ Play a NOTE for TIME milliseconds.
> : PlayNote OVER StartNote MS StopNote ;
> 
> 
> : handle-args  ARGC 1 > IF 1 ARG[] EVALUATE THEN ;
> 
> : play
>    instrument @ SetInstrument
>    70 500 PlayNote
>    72 500 PlayNote
>    68 500 PlayNote
>    56 500 PlayNote
>    63 1000 PlayNote
>    1000 MS
> ;
> 
> : doit   openmidi handle-args play closemidi ;
> ---------------------------------------
> 
> A midiplayer for actual midi files is easy given WINMM.DLL,
> but the margin is too small to contain it.
> 
> Groetjes Albert

BTW, according to my research, this is a much closer approximation to 
that theme:

---8<---
include lib/midi-w.4th

s" ce3k.mid" MIDopen abort" Can't open Midi file"

Square_Wave_Lead m.Use                 \ PC 81: Lead 1 (Square)

  0 &D  50 m.Play
  0 &E  50 m.Play
  0 &C  50 m.Play

-1 +to m.Octave

  0 &C  50 m.Play
  0 &G 100 m.Play

MIDclose depth .
---8<---

Hans Bezemer

Back to comp.lang.forth | Previous | Next — Previous in thread | Find similar | Unroll thread

Thread

Back & Forth - It still sounds MID.. [7b] Hans Bezemer <the.beez.speaks@gmail.com> - 2026-05-01 19:44 +0200
  Re: Back & Forth - It still sounds MID.. [7b] marcel hendrix <mhx@iae.nl> - 2026-07-03 15:24 +0200
    Re: Back & Forth - It still sounds MID.. [7b] dxf <dxforth@gmail.com> - 2026-07-05 18:33 +1000
    Re: Back & Forth - It still sounds MID.. [7b] Hans Bezemer <the.beez.speaks@gmail.com> - 2026-07-05 19:08 +0200
    Re: Back & Forth - It still sounds MID.. [7b] Hans Bezemer <the.beez.speaks@gmail.com> - 2026-07-09 18:18 +0200
      Re: Back & Forth - It still sounds MID.. [7b] Hans Bezemer <the.beez.speaks@gmail.com> - 2026-07-10 14:43 +0200
  Re: Back & Forth - It still sounds MID.. [7b] albert@SPENARNC.XS4ALL.NL - 2026-07-11 17:09 +0200
    Re: Back & Forth - It still sounds MID.. [7b] Hans Bezemer <the.beez.speaks@gmail.com> - 2026-07-11 18:21 +0200
      Re: Back & Forth - It still sounds MID.. [7b] dxf <dxforth@gmail.com> - 2026-07-12 15:02 +1000
        Re: Back & Forth - It still sounds MID.. [7b] Hans Bezemer <the.beez.speaks@gmail.com> - 2026-07-12 16:15 +0200
    Re: Back & Forth - It still sounds MID.. [7b] Hans Bezemer <the.beez.speaks@gmail.com> - 2026-07-11 18:49 +0200

csiph-web