HCC!Forth

HCC!forth

Tijdlijn

1994

In 1994 hield de HCC een dag waar computertalen vergeleken werden. Willem Ouwerkerk en Albert van der Horst ontwikkelden, staande de lezing?, een programma dat op een tingeltangel Vader Jacob speelt.

\ ==============================================================
\ [TITLE]     ANS Forth talendag word set. 
\ [FILE]      talendag.FRT
\ [CATEGORY]  Demo source 
\ [VSN]       1.00 
\ [CREATED]   January 18, 1994, Willem Ouwerkerk 
\ [LASTCHNGD] January 19, 1994, Willem Ouwerkerk 
\ [COPYRIGHT] Dutch Forth-gg 
\ [COMPILE]   Voor HCC-talendag
\ [MODULE OF] ANS Forth 
\ [USES]      ANS Forth 
\ [AUTHOR]    Willem Ouwerkerk/Albert van der Horst
\ [PURPOSE]   HCC-talendag hardware programmeer demo.

\ ==== Sheet 4: De printerpoort ================================

HEX

FF  378  PC!
00  378  PC!

378 CONSTANT POORT

FF POORT PC!
00 POORT PC!

DECIMAL

\ ==== Sheet 5: Hardware representatie =========================

BINARY

11111111 VALUE LATCH

: SET-BIT   ( Bitpatroon -- )
    LATCH 
    OR
    TO LATCH
    ;

: CLR-BIT   ( Bitpatroon -- )
    INVERT
    LATCH 
    AND
    TO LATCH
    ;

LATCH .

100 CLR-BIT  LATCH .
100 SET-BIT  LATCH .

DECIMAL

\ ==== Sheet 6: Data in schuifregister klokken =================

BINARY

: SET-DATA  ( -- )
    01000000 SET-BIT
    ;

: CLR-DATA  ( -- )
    01000000 CLR-BIT
    ;

: KLOK      ( -- )
    00100000 CLR-BIT
    LATCH POORT PC!
    00100000 SET-BIT
    LATCH POORT PC!
    ;

DECIMAL

SET-DATA KLOK KLOK KLOK KLOK
CLR-DATA KLOK KLOK KLOK KLOK

\ ==== Sheet 7: Schuifregister koppelen en ontkoppelen =========

BINARY

: GEKOPPELD  ( -- )
    00010000 SET-BIT
    LATCH POORT PC!
    ;

: ONTKOPPELD ( -- )
    00010000 CLR-BIT
    LATCH POORT PC!
    ;

DECIMAL
ONTKOPPELD  SET-DATA KLOK KLOK KLOK KLOK  GEKOPPELD
ONTKOPPELD  CLR-DATA KLOK KLOK KLOK KLOK  GEKOPPELD
ONTKOPPELD

\ ==== Sheet 8: We sturen een willekeurige rij tingels aan =====

DECIMAL

: SET-TINGELS   ( 32bits-data -- )
    ONTKOPPELD
    CLR-DATA
    16 0 
    DO      KLOK
    LOOP
    32 0
    DO      DUP $80000000 AND 0<>
            IF      SET-DATA    
            ELSE    CLR-DATA
            THEN
            KLOK
            1 LSHIFT
    LOOP    
    DROP                    ( Gooi gebruikte datawoord weg )
    GEKOPPELD
    ;


BINARY

00000000 SET-TINGELS
10101010 SET-TINGELS
11110000 SET-TINGELS
11111111 SET-TINGELS

DECIMAL

\ ==== Sheet 9: Hoe klinkt een noot goed =======================

DECIMAL

: C0    1 SET-TINGELS ;                                 C0
: C0    1 SET-TINGELS  0 SET-TINGELS ;                  C0
: C0    1 SET-TINGELS  1000 MS  0 SET-TINGELS ;         C0

50 VALUE PULSDUUR

BINARY

: C0    1 SET-TINGELS  PULSDUUR MS  0 SET-TINGELS ;     C0
: D0  100 SET-TINGELS  PULSDUUR MS  0 SET-TINGELS ;     C0 C0 D0

DECIMAL

400 VALUE NOOTLENGTE

BINARY

: C0    ( -- )
    1 SET-TINGELS  
    PULSDUUR MS  
    0 SET-TINGELS 
    NOOTLENGTE MS
    ;                                                   C0
: D0    ( -- )
    100 SET-TINGELS  
    PULSDUUR MS  
    0 SET-TINGELS 
    NOOTLENGTE MS
    ;                                                   C0 C0 D0

DECIMAL

\ ==== Sheet 10: We maken wat noten op zijn Forth's ============

DECIMAL

: NOOT      ( Bitwaarde -- )
    CREATE  ,
    DOES>   @ SET-TINGELS
            PULSDUUR MS
            0 SET-TINGELS
            NOOTLENGTE MS
            ;

BINARY

00000000000000001 NOOT G0
00000000000000100 NOOT A0
00000000000010000 NOOT B0
00000000000100000 NOOT C1
00000000010000000 NOOT D1
00000001000000000 NOOT E1
00000010000000000 NOOT F1
00001000000000000 NOOT G1
00100000000000000 NOOT A1
10000000000000000 NOOT B1

DECIMAL

D1 D1 C1 E1 E1 G1 F1

\ ==== Sheet 11: Ook de nootlengte is belangrijk ===============

DECIMAL

: ACHTSTE    150 PULSDUUR -  TO NOOTLENGTE ;
: KWART      300 PULSDUUR -  TO NOOTLENGTE ;
: HALF       600 PULSDUUR -  TO NOOTLENGTE ;
: HEEL      1200 PULSDUUR -  TO NOOTLENGTE ;

ACHTSTE G1 A1  KWART G1 A1  HALF  G1 A1  HEEL G1 A1  KWART G1 A1

\ ==== Sheet 12: We maken Vader Jacob ==========================

: REGEL1    KWART   C1 D1 E1 C1 ;

: REGEL2    KWART   E1 F1 HALF G1 ;

: REGEL3    ACHTSTE G1 A1 G1 F1 KWART E1 C1 ;

: REGEL4    KWART   C1 G0 HALF C1 ;

: VADER-JACOB   
    REGEL1  REGEL1
    REGEL2  REGEL2
    REGEL3  REGEL3
    REGEL4  REGEL4
    ;

\ ==== Sheet 13: Een stuk Paganini in ForMuLa ==================

\ -------------------------------------------------------------------------
Albert Paganini is veel te groot, neem maar een leesbaar stuk over, Willem.
\ -------------------------------------------------------------------------

\ Paganini, Cappriccio op. 1 # 24, the famous variations 
\ Transcription: Albert Nijhof, Oct 27, 93

\ Range a2-a5 

    SCORE Paganini

    Default PART

| 1 2 4 MEASURE
    /8  a3     /16 Rest a3       a3 c4 b3 a3
| 2     /8  e4     /16 Rest e3       e3 gis3 fis3 e3
| 3     1 REDO
| 4     /4  e4     /8  e3 Rest

  |: 1 4  9 NEXT? :|

| 9     /8  a4     /16 Rest a4       a4 bes4 a4 g4
| 10    /8  f4     /16 Rest d4       d4 f4 e4 d4
| 11    /8  g4     /16 Rest g4       g4 a4 g4 f4
| 12    /8  e4     /16 Rest c4       c4 e4 d4 c4
| 13    /8  f4     /16 Rest b3       b3 d4 c4 b3
| 14    /8  e4     /16 Rest a3       a3 c4 b3 a3
| 15    /8  f3     /16 Rest dis4     e3 e4 d4 b3
| 16    /4  a3     /8  a2     /12 Rest

( --1-- )

        /48 a4 c5
| 17    /12 e5 c5 a4    e4 c4      /24 a3       /48 e4 gis4
| 18    /12 b4 gis4 e4  b3 gis3    /24 e3       /48 a4 c5
| 19    /12 e5 c5 a4    e4 c4 a3
| 20    /4  e4          /8  e3     /12 Rest     /48 a4 c5

  |: 17 19  24 NEXT? :|

| 24    /4  e4         /8  e3      /12 Rest     /48 cis5 e5
| 25    /12 a5 e5 cis5  a4 e4      /24 cis4     /48 d3 f3
| 26    /12 a3 d4 f4    a4 d5      /24 f5       /48 b4 d5
| 27    /12 g5 d5 b4    g4 d4      /24 b3       /48 c3 e3 ( c3 was c2 )
| 28    /12 g3 c4 e4    g4 c5      /24 e5       /48 f5 d5
| 29    /12 b4 gis4 f4  d4 b3      /24 gis3     /48 e5 c5
| 30    /12 a4 e4 c4    a3 e3      /24 c3       /48 d3 f3
| 31    /12 b3 d4 f4    e3 e4 gis3
| 32    /4  a3     /8  a2 Rest

( --2-- )

| 33    /16 a3 gis3 a3     /24 gis3     /48 bes3
        /16 a3 b3 c4 d4
| 34    /16 e4 dis4 e4     /24 dis4     /48 f4
        /16 e4 d4 c4 b3
| 35    33 REDO
| 36    /16 e4 dis4 e4     /24 dis4     /48 f4
        /8  e4 e3

  |: 33 36  41 NEXT? :|

| 41    /16 a4 gis4 a4     /24 gis4     /48 bes4
        /16 a4 g4 f4 e4
| 42    /16 d4 cis4 d4     /24 cis4     /48 es4
        /16 d4 e4 f4 d4
| 43    /16 g4 fis4 g4     /24 fis4     /48 as4
        /16 g4 f4 e4 d4
| 44    /16 c4 b3 c4       /24 b3       /48 des4
        /16 c4 d4 e4 c4
| 45    /16 f4 e4 f4       /24 e4       /48 g4
        /16 f4 d4 c4 b3
| 46    /16 e4 dis4 e4     /24 dis4     /48 f4
        /16 e4 c4 b3 a3
| 47    /16 b3 ais3 b3     /24 ais3     /48 c4
        /16 b3 f4 e4 gis3
| 48    /16 a3 gis3 a3     /24 gis3     /48 b3
        /8  a3 Rest

( --3-- )

| 49    /4  { c3 c4 c5 }       /8  Sustain { a2 a3 a4 }
| 50    /24 gis3  /12 gis4
        /8  { b2 b3 b4 }       /4  { e3 e4 e5 }
| 51    49 REDO
| 52    /8  { b2 b3 b4 } { dis3 dis4 dis5 }
            { f3 f4 f5 } { e3 e4 e5 }

  |: 49 52  57 NEXT? :|

| 57    /4  { a3 a4 a5 }       /8  Sustain { cis3 cis4 cis5 }
| 58    /8  { d3 d4 d5 }       { e3 e4 e5 }
            { f3 f4 f5 }       { fis3 fis4 fis5 }
| 59    /4  { g3 g4 g5 }       /8  Sustain { b2 b3 b4 }
| 60    /8  { c3 c4 c5 }       { d3 d4 d5 }
            { dis3 dis4 dis5 } { e3 e4 e5 }
| 61    /4  { f3 f4 f5 }       /8  Sustain { b2 b3 b4 }
| 62    /4  { e3 e4 e5 }       /8  Sustain { a2 a3 a4 }
| 63    /8  { b2 b3 b4 }       { f3 f4 f5 }
            { e3 e4 e5 }
        /24 gis3  /12 gis4
| 64    /4  { b2 b3 b4 }       /8  { a2 a3 a4 } Rest

( --4-- )

| 65    /16 a4 a5 gis5 g5    fis5 f5 e5 dis5
| 66    /16 f5 e5 dis5 f5    e5 b4 gis4 e4
| 67    65 REDO
| 68    /16 f5 e5 dis5 f5
        /8  e5 e4

  |: 65 68  73 NEXT? :|

| 73    /16 a4 a5 gis5 g5    fis5 f5 e5 d5
| 74    /16 cis5 e5 a4 cis5  d5 a4 f4 d4
| 75    /16 g4 g5 fis5 f5    e5 es5 d5 c5
| 76    /16 b4 d5 g4 b4      c5 g4 e4 c4
| 77    /16 f4 f5 e4 es5     d5 cis5 c5 b4
| 78    /16 e4 e5 dis5 d5    cis5 c5 b4 a4
| 79    /16 f4 e4 es4 d4     cis4 c4 b3 gis3
| 80    /16 a3 a5 e5 c5      a4 e4 c4 a3

( --5-- )

| 81    /8  { a3 a4 }      /16 f4 f3 e4 e3       /8  chord
| 82    /8  { gis3 gis4 }  /16 dis5 dis4 e5 e4   /8  chord
| 83    81 REDO
| 84    /8  { gis3 gis4 }  /16 dis5 dis4 e5 e4   /8  Rest

  |: 81 84  89 NEXT? :|

| 89    /8  { c3 cis4 }    /16 gis5 bes4 a5 a4   /8  chord
| 90    /8  { d3 d4 }      /16 e4 e3 f4 f3       /8  { c3 c4 }
| 91    /8  { b2 b3 }      /16 as5 as4 g5 g4     /8  chord
| 92    /8  { c3 c4 }      /16 dis4 dis3 e4 e3   /8  chord
| 93    /8  { d3 d4 }      /16 b4 b3 bes4 bes3   /8  chord
| 94    /8  { e3 e4 }      /16 gis4 gis3 a4 a3   /8  { f3 f4 }
| 95    /8  { d3 d4 }      /16 f5 f4 e5 e4       /8  { e3 e4 }
| 96    /8  { a2 a3 }      /16 c4 c3 a4 a3       /8  Rest

( --6-- )

| 97    /4  { c5 e5 }   /8  Sustain
        /16 { b4 d5 } { a4 c5 }
| 98    /16 { gis4 b4 } { f4 a4 } { e4 gis4 } { d4 f4 }
            { c4 e4 } { b3 d4 } { a3 c4 } { gis3 b3 }
| 99    /4  { a3 c4 }   /8  Sustain
        /16 { b3 d4 } { c4 e4 }
| 100   /16 { b3 d4 } { a3 c4 } { gis3 b3 } { f3 a3 }
        /4  { e3 gis3 }

  |: 97 100  105 NEXT? :|

| 105   /4  { a2 a3 cis4 }   /8  Sustain
        /16 { b2 d4 } { cis3 e4 }
| 106   /16 { d3 f4 } { e3 g4 } { f3 a4 } { g3 b4 }
            { a3 cis5 } { b3 d5 } { cis4 e5 } { d4 f5 }
| 107   /4  { b2 g3 b3 }     /8  Sustain
        /16 { a2 c4 } { b2 d4 }
| 108   /16 { c3 e4 } { d3 f4 } { e3 g4 } { f3 a4 }
            { g3 b4 } { a3 c5 } { b3 d5 } { c4 e5 }
| 109   /4  { d4 f5 }        /8  Sustain
        /16 { c4 e5 } { b3 d5 }
| 110   /4  { c4 e5 }        /8  Sustain
        /16 { b3 d5 } { a3 c5 }
| 111   /8  { d3 f4 }
        /16 { e3 e4 } { f3 d4 }
            { e3 c4 } { a3 c4 } { e3 b3 } { gis3 b3 }
| 112   /4  a3      /8 a2 Rest

( --7-- )

| 113   /24 e5 f5 e5      /8  c5          Sustain        /24 a4 b4 a4
| 114   /24 b4 c5 b4      gis4 a4 gis4    e4 f4 e4       /8  e3
| 115   /24 e5 f5 e5      /8  c5          Rest           /24 a2 b2 a2
| 116   /24 b2 c3 b2      e3 f3 e3        gis3 a3 gis3   /8  e3

  |: 113 116  121 NEXT? :|

| 121   /24 e5 f5 e5      /8 cis5         Sustain        /24 a4 bes4 a4
| 122   /24 d5 e5 d5      a3 bes3 a3      f3 g3 f3           d3 e3 d3
| 123   /24 d5 e5 d5      /8 b4           Sustain        /24 g4 a4 g4
| 124   /24 c5 d5 c5      g3 a3 g3        e3 f3 e3           c3 d3 c3
| 125   /24 d5 e5 d5      /8 f5           Sustain        /24 d3 e3 d3
| 126   /24 c5 d5 c5      /8 e5           Sustain        /24 c3 d3 c3
| 127   /24 d5 e5 d5      b2 c3 b2        b4 c5 b4           gis3 a3 gis3
| 128   /24 a2 b2 a2      a4 b4 a4        /4 a2

( --8-- )

| 129   /48 a3 c4 e4 e5   /24 Sustain
        /48 c4 e4         /12 Rest
        /48 b3 d4 e4 e5   /24 Sustain
        /48 a3 c4         /12 Rest
| 130   /48 gis3 b3 e4 e5 /24 Sustain
        /48 e3 b3 b4      /16 Rest
        /48 fis3 a3 b3 b4 /24 Sustain
        /48 gis3 b3 e4    /16 Rest
| 131   129 REDO
| 132   /48 gis3 b3 e4 e5 /24 Sustain
    /48 f3 dis4 a4    /16 Rest
        /48 e3 e4 gis4    /16 Sustain
        /48 e3 e4 e5      /16 Rest

  |:  129 132  137 NEXT? :|

| 137   /48 a3 cis4 e4 e5 /24 Sustain
        /48 b3 d4         /12 Rest
        /48 cis4 e4 e5    /16 Sustain
        /48 a3 cis4 e4    /16 Rest
| 138   /48 d3 d4 f4 d5   /24 Sustain
        /48 g4 e5         /12 Rest
        /48 d3 d4 a4 f5   /24 Sustain
        /48 f4 d5         /12 Rest
| 139   /48 d3 g3 b3 g4   /24 Sustain
        /48 e3 c4         /12 Rest
        /48 f3 g3 d4 g4   /24 Sustain
        /48 d3 b3         /12 Rest
| 140   /48 c3 g3 e4      /16 Sustain
        /48 d3 g3 f4      /16 Rest
        /48 e3 g3 g4      /16 Sustain
        /48 c3 g3 e4      /16 Rest
| 141   /48 d3 b3 f4      /16 Sustain
        /48 b3 d4         /12 Rest
        /48 d3 b3 e4      /16 Sustain
        /48 b3 f4         /12 Rest
| 142   /48 c3 c4 e4      /16 Sustain
        /48 b2 b4 d5      /16 Sustain
        /48 a2 a3 c4      /16 Sustain
        /48 a2 g3 cis4    /16 Sustain
| 143   /48 d3 f3 d4      /16 Sustain
        /48 dis3 c4 a4    /16 Sustain
        /48 e3 a3 c4 e4 a4 Sustain
        /48 e3 b3 gis4    /16 Sustain
| 144   /32 a3 c4  /16 a4  /8 Sustain
        /8  a2 Rest

( --9-- )

| 145   /16 { c4 c5 } a4 { e4 e5 } { c3 c4 }
            { a3 a4 } { e3 e4 } c4 { a3 a4 }
| 146   /16 { b3 b4 } gis4 { e4 e5 } { d4 d5 }
             b4 { e4 e5 } { gis3 gis4 } { e4 e5 }
| 147   145 REDO
| 148   /16 { b3 b4 } gis4 { e4 e5 } { e3 e4 }
              b3 gis3   /8 e3

  |: 145 148  153 NEXT? :|

| 153   /16 { e4 e5 } cis5 a4 { e4 e5 }
            { cis3 cis4 } { a3 a4 } g3 e3
| 154   /16   f3 { d3 d4 } { d4 d5 } a4
            { f3 f4 } d4 f3 { d3 d4 }
| 155   /16 { d4 d5 } b4 g4 { f3 f4 }
              d4 { b2 b3 } f3 { d3 d4 }
| 156   /16   e3 c3 { c4 c5 } g4
            { e4 e5 } c4 e3 c3
| 157   /16 { b3 b4 } a4 gis4 f4
            { e4 e5 } { d3 d4 } c4 b3
| 158   /16 { a3 a4 } g3 f3 e3
            { d3 d4 } c3 b2 a2
| 159   /16   f3 { d3 d4 } { a3 a4 } f4
              gis3 e3 { b3 b4 } gis4
| 160   /16 { a3 a4 } { e4 e5 } { c3 c4 } { a3 a4 }
        /8  { a2 a5 } Rest

( --10-- )

| 161   /4  a4                /8  Sustain  /16 e4 c5
| 162   /16 b4 a4 gis4 fis4       e4 fis4 gis4 e4
| 163   /4  a4                /16 Sustain b4 c5 d5
| 164   /8  dis5  /16 Sustain e5    /4  { e3 e4 }

  |: 161 164  169 NEXT? :|

| 169   /4  a4                /16 Sustain e5 cis5 a4
| 170   /16 g4 e4 cis4 a3         g3 f3 e3 d3
| 171   /4  g4                /16 Sustain d5 b4 g4
| 172   /16 f4 d4 b3 g3           f3 e3 d3 c3
| 173   /4  f4                /16 Sustain d4 b3 a3
| 174   /16 gis3 e3 d3 b2         c3 e3 a3 g3
| 175   /16 f3 d4 b3 a3           gis3 b4 gis4 e4
| 176   /32 gis5 a5  /16 Sustain  /8 Sustain  { a2 a3 } Rest

( --11-- )

| 177   /16 { c3 e3 } { a3 e4 }       { c3 e3 } { a3 e4 }
            { b2 gis3 } { b3 e4 }     { a2 e3 } { c4 e4 }
| 178   /32   e3 dis3 e3 gis3           b3 e4 gis4 b4
        /16 { e4 e5 } gis4 b4 e5
| 179   /16 { c3 e3 } { a3 e4 }       { c3 e3 } { a3 e4 }
            { b2 gis3 } { e4 b4 }     { a2 e3 } { c4 a4 }
| 180   /16 { e3 gis3 } e5 b4 gis4      e4 b3 gis3 e3

  |: 177 180  185 NEXT? :|

| 185   /16 { cis3 a3 } { e4 cis5 }   { cis3 a3 } { e4 cis5 }
            { d3 a3 } { f4 d5 }       { e3 cis4 } { a4 e5 }
| 186   /24 f3 d3 f3                /32 a3 d4 f4 a4
        /16 { d4 d5 } f4 a4 d5
| 187   /16 { b2 g3 } { d4 b4 }       { b2 g3 } { d4 b4 }
            { c3 g3 } { e4 c5 }       { d3 b3 } { g4 d5 }
| 188   /24 e3 c3 e3                /32 g3 c4 e4 g4
        /16 { c4 c5 } e4 g4 c5
| 189   /16 { d3 b3 } { f4 d5 }       { d3 b3 } { f4 d5 }
            { c3 a3 } { e4 c5 }       { b2 gis3 } { e4 b4 }
| 190   /16 { a2 e3 } { c4 a4 }       { b2 gis3 } { e4 b4 }
            { c3 a3 } { e4 c5 }       { dis3 c4 } { a4 fis5 }
| 191   /24 e3 a3 c4 e4 a4 c5
            e3 gis3 b3 e4 gis4 b4

( --finale-- )

| 192   /24 a2 c3 e3 a3 c4 e4         a4 e4 c4 a3 e3 c3
| 193   /24 a2 cis3 e3 a3 cis4 e4     a4 e4 cis4 a3 e3 cis3
| 194   /24 d3 f3 a3 d4 f4 a4     /16 { d4 d5 } f4 a4 d5
| 195   /16 { b2 gis3 } { f4 d5 }     { d3 b3 } { gis4 f5 }
            { f3 d4 } { b4 gis5 }     { b2 gis3 } { f4 d5 }

  |: 192 195  200 NEXT? :|

| 200   /24 a2 cis3 e3                a3 cis4 e4
            { a3 a4 } e4 cis4         a3 e3 cis3
| 201   /24 a2 cis3 e3
        /32 a3 cis4 e4 a4
            { cis4 cis5 } a4 e4 cis4
        /24 a3 e3 cis3
| 202   /32 a2 cis3 e3 a3             cis4 e4 a4 cis5
            { e4 e5 } cis5 a4 e4      cis4 a3 e3 cis3
| 203   /24 a2
        /32 cis3 e3 a3 cis4
        /48 e4 a4 cis5 e5
            { a4 a5 } e5 cis5 a4
        /32 e4 cis4 a3 e3
        /24 cis3
| 204   /24 a2 b2 a2
        /32 b2 a2 b2 a2
            b2 a2 b2 a2
        /24 b2 a2 b2
| 205   204 REDO
| 206   /8 { a2 cis3 e3 a3 cis4 e4 a4 cis5 e5 a5 } Rest Rest Rest
||

\ ==============================================================
                    \ (* End of Source *) /