Computer Music Interactif…cial Edition 1999 Winter/cd 3.iso/mac/Mac/Shares/Midishare™1.68/Development Tools/Sources Examples/msEcho/msEcho.p

Text File | 1992-03-07 | 34.8 KB | 946 lines | [TEXT/MPS ]

{••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••}
{•                                  ECHO                                        •}
{•------------------------------------------------------------------------------•}
{•                                                                                 •}
{• Le programme ECHO présenté ici, fait partie d'une série d'exemples à         •}
{• caractère pédagogique (enfin j'espère !) sur la façon d'utiliser MIDISHARE.    •}
{•                                                                                 •}
{• Comme son nom l'indique, ECHO effectue un écho temps-réel sur les notes        •}
{• reçues. Il dispose de quatre types de controles :                            •}
{•       - Le delai entre les échos successifs (en millisecondes)               •}
{•       - La variation de vélocité entre les échos successifs.                    •}
{•       - La variation de hauteur entre les échos successifs.                    •}
{•       - Le choix du canal Midi de réception.                                    •}
{•                                                                                •}
{•------------------------------------------------------------------------------•}
{•        © GRAME 1989, Yann Orlarey et Hervé Lequay                                •}
{••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••}


Program Echo;

USES    Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, Traps, MIDIShareUnit;


const    AppleID    = 128;    AppleMenu    = 1;
        FileID    = 129;    FileMenu    = 2;
        EditID    = 130;    EditMenu    = 3;
            UndoI    = 1;    CutI    = 3;    CopyI    = 4;    PasteI    = 5;    ClearI    = 6;

    WindowID    = 128;                     { ID fenêtre de l'application        }
    AboutID        = 129;
    AlertID        = 500;

    resumeMask    = $01;                    { suspend/resume mask                }


    DelaySB     = 1;                    { Item ScrollBar du delai            }
    VelSB         = 2;                    { Item ScrollBar de la vélocité        }
    PitchSB     = 3;                    { Item ScrollBar de la hauteur        }
    ChanSB         = 4;                    { Item ScrollBar du canal Midi        }

    DelayTXT     = 5;                    { Item Affichage du delai            }
    VelTXT         = 6;                    { Item Affichage de la vélocité        }
    PitchTXT     = 7;                    { Item Affichage de la hauteur        }
    ChanTXT        = 8;                    { Item Affichage du canal Midi        }


type
    TCtrlInfoPtr = ^TCtrlInfo;
    TCtrlInfo    = record                { Info necessaires pour les ScrollBar    }
            val:    integer;                { valeur courante                    }
            mode:    integer;                { 0: horizontal, 1: vertical        }
            Disp:    integer;                { numéro de l'item à mettre à jour    }
            DVal:    integer;                { ambitus des valeur                }
            DPos:     integer;                { ambitus des positions                }
            oldVal:    integer;                { valeur au début du Track            }
            oldPos:    integer;                { position au début du Track        }
        end;
var
    myRefNum:                integer;                            { numéro d'appl. Midi                }
    myFilter:                 TFilter;                            { filtre pour les événements Midi    }

    myWindow:                 windowPtr;                            { fenêtre                            }

    doneFlag:                boolean;                            { flag d'arrêt                        }

    gMac:                    SysEnvRec;                            { machine…                            }
    eventPending:            boolean;                            { vrai si événement en attente        }
    hasWNE:                    boolean;                            { vrai si WaitNextEvent implémenté    }
    foreGround:                boolean;                            { vrai si en foreGround                }

    myEvent:                eventRecord;                        { pour la main event loop            }
    theChar:                char;                                { pour la gestion des touches        }
    dragRect:                rect;                                { rect de déplacement de fenêtre    }
    myMenus:                array[AppleMenu..EditMenu] of MenuHandle;
                                                                { les menus                            }
    whichItem:                integer;                            { item sélectionné                    }
    whichCtrl:                ControlHandle;                        { Control sélectionné                }
    whichInfo:                TCtrlInfoPtr;                        { infos relatives au Ctrl select.    }

    theDelay,
    theVel,
    thePitch,
    theChan:                TCtrlInfo;                            { info relatives aux ScrollBar        }

    theDuration:            integer;                            { durée par défaut des notes        }



(********************************************************************************)
(*                                 UTILITAIRES                                        *)
(*------------------------------------------------------------------------------*)
(*                                                                                 *)
(********************************************************************************)

{$S Initialize}
Function TRAPAVAILABLE (tNumber: integer; tType: trapType): boolean;
(*    Vérification de l'implémentation d'une trappe                                *)
begin
    TrapAvailable:= NGetTrapAddress(tNumber,tType) <> GetTrapAddress(_Unimplemented)
end;

{$S Main}
Function ISAPPWINDOW (aWind: windowPtr): boolean;
(* vérifie si la fenêtre appartient à l'application                                *)
begin
    if aWind = nil then
        IsAppWindow:= false
    else
        IsAppWindow:= windowPeek(aWind)^.windowKind >= 0
end;

{$S Main}
Function ISDAWINDOW (aWind: windowPtr): boolean;
(* vérifie si la fenêtre appartient à un accessoire de bureau                    *)
begin
    if aWind = nil then
        IsDAWindow:= false
    else
        IsDAWindow:= windowPeek(aWind)^.windowKind < 0
end;

{$S Main}
Procedure CenterRectOnScreen (var aRect: Rect);
{ aRect rectangle global à centrer sur écran (dragRect)                    }
var    screenSize    : Point;
    rectSize    : Point;
begin
    with dragRect do
        SetPt(screenSize,right - left,bottom - top);
    with aRect do begin
        SetPt(rectSize,right - left,bottom - top);
        left:= dragRect.left + (screenSize.h - rectSize.h) div 2;
        top:= dragRect.top + (screenSize.v - rectSize.v) div 5;
        topLeft:= point(PinRect(dragRect,topLeft));
        right:= left + rectSize.h;
        bottom:= top + rectSize.v;
        end;
end;

{$S Main}
Function GetNewCenteredDialog (dialogID: integer): DialogPtr;
var    dlogTemplate    : DialogTHndl;
begin
    GetNewCenteredDialog := nil;
    dlogTemplate := DialogTHndl(GetResource('DLOG', dialogID));
    if dlogTemplate <> nil then begin
        CenterRectOnScreen(dlogTemplate^^.boundsRect);
        GetNewCenteredDialog:= GetNewDialog(dialogID, nil, pointer(-1));
        end
    else SysBeep(2)                                                { At least give some indication }
end;

{$S Main}
Procedure AlertUser (alertID: integer);
var    alrtTemplate    : AlertTHndl;
    temp            : integer;
begin
    alrtTemplate := AlertTHndl(GetResource('ALRT', alertID));
    if alrtTemplate <> nil then begin
        SetCursor(arrow);
        CenterRectOnScreen(alrtTemplate^^.boundsRect);
        temp:= Alert(alertID,nil)
        end
    else SysBeep(2)                                             { At least give some indication        }
end;


(********************************************************************************)
(*                                 SET UP MENUS                                    *)
(*------------------------------------------------------------------------------*)
(* Installation de la barre de menus                                              *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aucun                                                                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Initialize}
Procedure SETUPMENUS;
var    i:    integer;
begin
    myMenus[AppleMenu] := GetMenu(AppleID);                        { menu Pomme                        }
    AddResMenu(myMenus[AppleMenu],'DRVR');                        { ajout des accessoires de bureau    }
    myMenus[FileMenu] := GetMenu(FileID);                        { menu Fichier                        }
    myMenus[EditMenu] := GetMenu(EditID);                        { menu Edit                            }
    for i := AppleMenu to EditMenu do
        InsertMenu(myMenus[i], 0);
    DrawMenuBar                                                    { affiche la barre des menus        }
end;


(********************************************************************************)
(*                                 MIN et MAX                                        *)
(*------------------------------------------------------------------------------*)
(* Calcul du Minimum et du Maximun de deux entiers.                                  *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        n1    :    entier                                                            *)
(*        n2    :    entier                                                            *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
Function Max (n1,n2: integer): integer;
begin
    if n1<n2 then Max := n2 else Max := n1
end;

Function Min (n1,n2: integer): integer;
begin
    if n1>n2 then Min := n2 else Min := n1
end;


(********************************************************************************)
(*                                 SET DIA TEXT                                    *)
(*------------------------------------------------------------------------------*)
(* Routine pour changer le texte d'un item de dialogue.                            *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        d    :    pointeur sur un dialogue.                                        *)
(*        i    :    numéro de l'item dont on veut changer le texte.                    *)
(*        s    :    chaine de caractères à placer.                                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure setDiaText (d: dialogPtr; i: integer; s: str255);
    var t: integer;
        h: handle;
        r: rect;
    begin
        getDItem(d,i,t,h,r);
        if t < statText then
            setCTitle(controlHandle(h),s)
        else {if t < iconItem then}
            setIText(h,s);
    end;


(********************************************************************************)
(*                                 SET DIA NUM                                        *)
(*------------------------------------------------------------------------------*)
(* Routine pour changer le texte d'un item de dialogue.                            *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        d    :    pointeur sur un dialogue.                                        *)
(*        i    :    numéro de l'item dont on veut changer le texte.                    *)
(*        n    :    valeur numérique à afficher.                                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure setDiaNum (d: dialogPtr; i: integer; n: longint);
    var t: integer;
        h: handle;
        r: rect;
        s: str255;
    begin
        numToString(n,s);
        setDiaText(d,i,s);
    end;


(********************************************************************************)
(*                                 ECHO NOTE                                        *)
(*------------------------------------------------------------------------------*)
(* La procedure de calcul de l'écho. Elle est appelée sous interruptions à         *)
(* chaque réception d'une note. Ensuite, elle se rappelle récursivement         *)
(* pour calculer les échos suivants, par le biais d'un MidiCall qui réalise un     *)
(* appel différé dans le temps.                                                    *)
(*                                                                                 *)
(* Le principe de cette procédure d'écho est faire circuler une note            *)
(* dont la hauteur et la vélocité varient à chaque écho jusqu'a ce que l'un des    *)
(* deux paramètres sorte des bornes 0 à 127. De plus, à chaque écho, une copie     *)
(* de cette note est envoyée.                                                    *)
(*                                                                                 *)
(* Les paramètres d'un appel par le biais d'un MidiCall sont imposés, et sont     *)
(* au nombre de cinq : la date de l'appel (longint), le numéro de référence de     *)
(* l'application (integer), et trois paramètres dont l'usage est libre sous        *)
(* réserve qu'ils soient de la taille d'un longint ou d'un pointeur.            *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*         d:        date de l'appel (longint, en ms)                                *)
(*         myRefNum:    numéro de référence unique de l'application (integer)        *)
(*         e:        pointeur sur la note dont il faut calculer l'écho                *)
(*        a2,a3:    paramètres obligatoires, mais non utilisés ici.                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure echoNote(d: longint; myRefNum: integer; e: midiEvPtr; a2,a3: longint);
var    c:        midiEvPtr;
    v,p:    integer;
begin
    c := midiCopyEv(e);                                            { crée une copie de la note        }
    if c <> Nil then midiSendAt(myRefNum, c, d);                { si la copie a réussi, l'emet    }
    v := e^.vel+theVel.val;                                        { calc. la nouvelle vélocité    }
    p := e^.pitch+thePitch.val;                                    { calc. la nouvelle hauteur        }
    if (v>0) and (v<128) and (p>=0) and (p<128) then begin        { si dans les limites 0..127    }
        e^.vel := v; e^.pitch := p;                                { met à jour la note            }
        midiCall (@echoNote, d+theDelay.val, myRefNum, longint(e), 0, 0) { et se rappel à la date voulue}
    end else
        midiFreeEv(e)                                            { sinon, detruit la note et fin    }
end;



(********************************************************************************)
(*                             TREAT MIDI EVENTS                                    *)
(*------------------------------------------------------------------------------*)
(* La procedure de réception des événements Midi. Elle est appelée automatique-    *)
(* ment par MidiShare, sous    interruptions, chaque fois que l'application        *)
(* reçoit de nouveaux événements.                                                 *)
(*                                                                                 *)
(* Pour ce faire, l'adresse de cette routine à été fournie à MidiShare à         *)
(* l'ouverture de l'application par un MidiSetRcvAlarm.                            *)
(*                                                                                 *)
(* Cette procédure doit obligatoirement comporter un paramètre, qui est le         *)
(* numéro de référence unique de l'application (integer).                        *)
(*                                                                                 *)
(* Le principe de cette procédure est d'aller récupérer les événements reçus,    *)
(* de vérifier qu'ils sont du bon canal et d'appeler s'il y a lieu la procédure *)
(* d'écho par le biais d'un MidiCall différé dans le temps.                        *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        myRefNum:    numéro de référence Midi de l'application.                        *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure treatMidiEvents(myRefNum: integer);
var    e:        MidiEvPtr;
    d,n:     longint;
begin
    n := midiCountEvs(myRefNum);                                    { compte les événements reçus        }
    d := midiGetTime+theDelay.val;                                { calc. la date du prochain echo    }
    while n > 0 do begin                                        { tant qu'il reste des Ev à traiter    }
        e := midiGetEv(myRefNum);                                    { en prendre un et :                    }
        if (theChan.val<>0) and (theChan.val <> e^.chan + 1) then    { vérifier son canal            }
            midiFreeEv(e)                                        { s'il n'est pas bon, le détruire    }
        else if e^.evType = typeNote then                         { si c'est une note,                 }
            midiCall (@echoNote, d, myRefNum, longint(e), 0, 0)    {  appeler la proc. EchoNote         }
        else if e^.vel>0 then begin                                { si c'est un KeyOn de vel>0        }
            e^.evType     := typeNote;                            {  le transformer en une note        }
            e^.dur        := theDuration;                            {  définir une durée par defaut        }
            midiCall (@echoNote, d, myRefNum, longint(e), 0, 0)    {  appeler la proc. EchoNote        }
           end
        else midiFreeEv(e);                                        { sinon le détruire                    }
        n := n-1;
    end
end;


(********************************************************************************)
(*                             SET UP FILTERS                                        *)
(*------------------------------------------------------------------------------*)
(* Cette procédure définit les valeurs du filtre de l'application. Un filtre     *)
(* est composé de trois parties, qui sont trois tableaux de booléens :            *)
(*                                                                                 *)
(*        un tableau de 256 bits pour les ports Midi acceptés                        *)
(*        un tableau de 256 bits pour les types d'événements acceptés                *)
(*        un tableau de  16 bits pour les canaux Midi acceptés                    *)
(*                                                                                 *)
(* Les bits sont positionnés à True pour accepter et à False pour refuser.         *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aFilter:    un filtre MidiShare.                                        *)
(*                                                                                 *)
(********************************************************************************)

{$S Initialize}
procedure setUpFilters(var aFilter: TFilter);
var i:    integer;
begin
    for i := 0 to 255 do begin                    { à priori on refuse tout        }
        myFilter.port[i] := false;
        myFilter.evType[i] := false;
    end;
                                                { mais on accepte                }
    myFilter.port[modemPort]     := true;        { les événements en provenance    }
    myFilter.port[printerPort]     := true;        { des ports Modem et Printer    }

    myFilter.evType[typeNote]     := true;        { les événements de type Note    }
    myFilter.evType[typeKeyOn]     := true;        { et de type Key On                }

    for i := 0 to 15 do begin                    { sur les 16 canaux Midi         }
        myFilter.channel[i] := true;
    end;
                                                { enfin,                        }
    midisetFilter(myRefNum,@aFilter)                { on passe le filtre à MidiShare}
end;


(********************************************************************************)
(*                                 SET UP MIDI                                        *)
(*------------------------------------------------------------------------------*)
(* Cette procédure définit les différents paramètres necessaires au fonction-    *)
(* nement Midi de l'application. Tout d'abord, le MidiOpen de l'application        *)
(* qui lui permet de se signaler à MidiShare, et d'obtenir un numèro de réfé-    *)
(* rence unique pour la suite des opérations. La chaine de caractères passée en    *)
(* argument sert au catalogue des applications ouvertes que maintient MidiShare.*)
(* Ensuite la définition de l'alarme de réception, une procédure appelée auto-    *)
(* matiquement par MidiShare, à chaque fois que l'application va recevoir de    *)
(* nouveaux événements. Troisièmement, la définition des filtres de réceptions    *)
(* qui permettent à l'application de spécifier à MidiShare les événements         *)
(* qu'elle désire recevoir. Enfin l'établissement des connections qui vont         *)
(* relier l'entrée et la sortie de l'application aux ports Midi externes.        *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aucun paramètre.                                                        *)
(*                                                                                 *)
(********************************************************************************)

{$S Initialize}
procedure SetUpMidi;
var    name:        str255;
    apRefNum:    integer;
    apParam:    Handle;
    aRefNum:    integer;

    Procedure FAILSETUP (strIndex: integer);
    var    msgStr:    str255;
    begin
        GetIndString (msgStr,AlertID,strIndex);                { message d'alerte suivant erreur    }
        ParamText(name,msgStr,'','');
        AlertUser(AlertID);
        ExitToShell                                                { et quitte                            }
    end;

begin
    GetAppParms(name,apRefNum,apParam);                    { récupérer le nom d'application    }
    if not MidiShare then
        FailSetUp(1);                                    { MidiShare n'est pas installé        }

    myRefNum:= MidiOpen(name);                            { ouverture en Midi                    }
    if myRefNum = MidiErrSpace then
        FailSetUp(2);                                    { impossible, plus de place            }

    midiSetRcvAlarm(myRefNum, @treatMidiEvents);        { définit la procédure de réception    }
    setUpFilters(myFilter);                                { programmation des filtres            }
    midiConnect(0,myRefNum,true);                        { connecte l'appl. aux entrées Midi    }
    midiConnect(myRefNum,0,true);                        { connecte l'appl. aux sorties Midi }
end;


(********************************************************************************)
(*                                 SET UP SCROLL BAR                                *)
(*------------------------------------------------------------------------------*)
(* Cette procédure crée l'enrobage necessaire au suivi des scrollBar.            *)
(* afficheurs.                                                                    *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        d        :    pointeur vers le dialogue concerné.                            *)
(*        info    :    pointeur vers info necessaires au suivi du ScrollBar.        *)
(*        me        :    numéro d'item du ScrollBar.                                    *)
(*        disp    :    numéro d'item du texte d'affichage de la valeur du ScrollB.    *)
(*        dir        :    direction du ScrollBar: 0 = horiz., 1 = vert.                *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure SetUpScrollBar(d: dialogPtr; info: TCtrlInfoPtr; me, disp: integer; dir: integer);
var    h:        controlHandle;
    t,v:    integer;
    r:        rect;
begin
    getDItem(d,me,t,handle(h),r);                    { récupère le SB d'aprés son num. d'item}
    setCRefCon(h, longint(info));                    { lui attache les info pour le suivi.    }
    info^.val  := getCtlValue(h);                     { récupère la valeur courante du SB.    }
    setDiaNum(d,disp,info^.val);                    { l'affiche une première fois.            }
    info^.mode := dir;                                { définit la dir. du SB (Horiz. ou Vert.)}
    info^.disp := disp;                                { définit l'item servant à l'affichage.    }
    info^.DVal := GetCtlMax(h)-GetCtlMin(h);        { définit l'ambitus des valeurs.        }
    if dir=0 then                                    { définit la largeur du SB.                }
        info^.Dpos := h^^.contrlRect.right - h^^.contrlRect.left - 3*16
    else
        info^.Dpos := h^^.contrlRect.bottom - h^^.contrlRect.top - 3*16;
end;


(********************************************************************************)
(*                                 THUMBH ACTION                                    *)
(*------------------------------------------------------------------------------*)
(* Suivi du Thumb d'un ScrollBar horizontal, avec mise à jour en continu d'un    *)
(* item affichant la valeur courante.                                            *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aucuns paramètres.                                                        *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure thumbHAction;
var    p:        point;
    n:        longint;
    b:         boolean;
    aEvent:    EventRecord;
begin
    getMouse(p);                                    { calcul de la nouvelle valeur    }
    with whichInfo^ do n := longint(oldVal)+longint(Dval)*longint(p.h - oldPos) div longint(Dpos);
    n := max (n, getCtlMin(whichCtrl));                { par une règle de trois et     }
    n := min (n, getCtlMax(whichCtrl));                { contrainte entre min et max.    }
    if n <> whichInfo^.val then begin                { Si la valeur à changée:        }
        whichInfo^.val := n;                        { mise à jour de la valeur        }
        setDiaNum(myWindow, whichInfo^.disp, n);    { et affichage.                    }
    end;
    if hasWNE then                                    { donne la main aux autres applications }
        b:= WaitNextEvent(everyEvent, aEvent, 0, nil)
    else begin
        SystemTask;
        b:= GetNextEvent(everyEvent, aEvent)
    end;
end;


(********************************************************************************)
(*                                 THUMBV ACTION                                    *)
(*------------------------------------------------------------------------------*)
(* Suivi du Thumb d'un ScrollBar vertical, avec mise à jour en continu d'un        *)
(* item affichant la valeur courante.                                            *)
(********************************************************************************)

{$S Main}
procedure thumbVAction;
var    p:        point;
    n:        longint;
    b:         boolean;
    aEvent:    EventRecord;
begin
    getMouse(p);                                    { calcul de la nouvelle valeur    }
    with whichInfo^ do n := longint(oldVal)+longint(Dval)*longint(p.v - oldPos) div longint(Dpos);
    n := max (n, getCtlMin(whichCtrl));                { par une règle de trois et     }
    n := min (n, getCtlMax(whichCtrl));                { contrainte entre min et max.    }
    if n <> whichInfo^.val then begin                { Si la valeur à changée:        }
        whichInfo^.val := n;                        { mise à jour de la valeur        }
        setDiaNum(myWindow, whichInfo^.disp, n);    { et affichage.                    }
    end;
    b := GetNextEvent(everyEvent, aEvent)            { pour donner un peu la main    }
end;                                                { aux autres appl.                }


(********************************************************************************)
(*                                 NORMAL ACTION                                    *)
(*------------------------------------------------------------------------------*)
(* Suivi des autres parties d'un ScrollBar, avec mise à jour en continu d'un    *)
(* item affichant la valeur courante.                                            *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aucun paramètre.                                                        *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure normalAction (h: controlHandle; part: integer);
var    n:        integer;
    b:         boolean;
    aEvent:    EventRecord;
begin
    case part of
        inUpButton:     setCtlValue(h,getCtlValue(h)-1);    { on réalise les différents    }
        inDownButton:     setCtlValue(h,getCtlValue(h)+1);    { incréments ou décréments    }
        inPageUp:         setCtlValue(h,getCtlValue(h)-10);    { de la valeur du SB,         }
        inPageDown:     setCtlValue(h,getCtlValue(h)+10);    { suivant la partie cliquée    }
    end;
    if part <> 0 then begin                                    { si une partie est cliquée    }
        n := getCtlValue(h);
        if whichInfo^.val <> n then begin                    { et si la valeur du SB à     }
            whichInfo^.val := n;                            { changée, alors on met à    }
            setDiaNum(myWindow, whichInfo^.disp, n);        { jour cette valeur et on    }
        end;                                                { l'affiche.                }
    end;
    b := GetNextEvent(everyEvent, aEvent)                    { pour donner un peu la main}
end;                                                        { aux autres appl.            }


(********************************************************************************)
(*                                 TRACK DIALOG                                    *)
(*------------------------------------------------------------------------------*)
(* Procédure chargé de trouver le scrollBar selectionné et de déclencher son    *)
(* suivi.                                                                        *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        w    :    pointeur sur la fenêtre de dialogue.                            *)
(*        p    :    point où la sourie à été clickée.                                *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
procedure TrackDialog(w: windowPtr; p: point);
var
    part,res:    integer;
begin
    GlobalToLocal(p);                                        { conversion du point en local    }
    part := FindControl(p,w,whichCtrl);                        { cherche le SB concerné        }
    if part=0 then exit(trackDialog);                        { si aucun, abandon                }
    whichInfo := TCtrlInfoPtr(getCRefCon(whichCtrl));        { récupere les info de ce SB    }
    if part = inThumb then begin                            { s'il faut suivre le Thumb        }
        whichInfo^.oldVal := getCtlValue(whichCtrl);        { on récupère la valeur actuelle}
        if whichInfo^.mode = 0 then begin                    { pour un SB horizontal:        }
            whichInfo^.oldPos := p.h;                        {  on récupère la position en x    }
            res := trackControl(whichCtrl,p,@thumbHAction)    {  et on suit le Thumb.            }
        end else begin                                        { pour un SB vertical:            }
            whichInfo^.oldPos := p.v;                        {  on récupère la position en y    }
            res := trackControl(whichCtrl,p,@thumbVAction)    {  et on suit le Thumb.            }
        end;
    end else begin                                            { pour les autres parties:        }
        res := trackControl (whichCtrl,p,@normalAction);    {  on suit normalement            }
    end;
end;


(********************************************************************************)
(*                             SET UP WINDOWS                                        *)
(*------------------------------------------------------------------------------*)
(* Procédure chargé d'ouvrir la fenêtre et de réaliser les initialisations         *)
(* necessaires.                                                                    *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aucun paramètre.                                                        *)
(*                                                                                 *)
(********************************************************************************)

{$S Initialize}
procedure SetUpWindow;
var    r    : rect;
begin
    with screenBits.bounds do                                    { rect max de déplacmt de fenêtre    }
        SetRect(dragRect, 4, 24, right - 4, bottom - 4);
    myWindow := GetNewDialog(WindowID,nil,pointer(-1));
    SetPort(myWindow);
    r:= myWindow^.portRect;
    with r do begin
        LocalToGlobal(topLeft);
        LocalToGlobal(botRight)
        end;
    if not RectInRgn(r,GetGrayRgn) then begin
        CenterRectOnScreen(r);
        MoveWindow(myWindow,r.left,r.top,true)
        end;
    textFont(Monaco);
    textSize(9);
    textMode(srcCopy);
    SetUpScrollBar(myWindow, @theDelay, DelaySB, DelayTXT, 0);    { réalise les associations    }
    SetUpScrollBar(myWindow, @theVel, VelSB, VelTXT, 0);        { entres les 4 ScrollBars    }
    SetUpScrollBar(myWindow, @thePitch, PitchSB, PitchTXT, 0);    { et les 4 items d'affichage}
    SetUpScrollBar(myWindow, @theChan, ChanSB, ChanTXT, 1);        { du dialogue                }
    theDuration := 50;
    ShowWindow(myWindow)
end;

{$S Main}
Procedure SaveWindowPos;
type    rectPtr  =     ^rect;
        rectHdle =    ^rectPtr;
var    windHdle:    handle;
begin
    windHdle:= Get1Resource('DLOG',WindowID);
    rectHdle(windHdle)^^:= windowPeek(myWindow)^.contRgn^^.rgnBBox;
    ChangedResource(windHdle);
    if ResError = noErr then
        WriteResource(windHdle)
end;


(********************************************************************************)
(*                                 INITIALIZE                                        *)
(*------------------------------------------------------------------------------*)
(* Initialisations générales (hasWNE, foreGround, managers, fenêtre, Midi)        *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aucun                                                                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Initialize}
Procedure INITIALIZE;
var    err:    OSErr;
begin
    err:= SysEnvirons(1,gMac);
    hasWNE:= (gMac.machineType >= 0) & TrapAvailable(_WaitNextEvent,ToolTrap);

    InitGraf(@thePort);                                            { initialisations standard            }
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(NIL);
    InitCursor;
    SetUpMenus;                                                    { mise en place menus                }
    SetUpMidi;                                                    { ouverture MidiShare                }
    SetUpWindow;                                                { initialisations fenêtre et listes    }
end;


(********************************************************************************)
(*                                 ADJUST MENUS                                    *)
(*------------------------------------------------------------------------------*)
(* Ajustement de la barre de menus suivant la fenêtre de premier plan, juste    *)
(* lors d'un click dans la barre des menus                                        *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        aucun                                                                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
Procedure ADJUSTMENUS;
begin
    if IsAppWindow(FrontWindow) then begin
        DisableItem(myMenus[EditMenu],UndoI);
        DisableItem(myMenus[EditMenu],CutI);
        DisableItem(myMenus[EditMenu],CopyI);
        DisableItem(myMenus[EditMenu],PasteI);
        DisableItem(myMenus[EditMenu],ClearI)
        end
    else
    if IsDAWindow(FrontWindow) then begin
        EnableItem(myMenus[EditMenu],UndoI);
        EnableItem(myMenus[EditMenu],CutI);
        EnableItem(myMenus[EditMenu],CopyI);
        EnableItem(myMenus[EditMenu],PasteI);
        EnableItem(myMenus[EditMenu],ClearI)
        end
end;


(********************************************************************************)
(*                                 DO COMMAND                                        *)
(*------------------------------------------------------------------------------*)
(* Gère les menus: Pomme (About), File (Quit)                                    *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        mResult: numéro de menu et d'item retournés par MenuSelect et MenuKey    *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
Procedure DOCOMMAND ( mResult: LONGINT);
var    theItem:    integer;
    name:        str255;
    sysEdit:    boolean;

    Procedure SHOWABOUT;
    var    myDialog    : dialogPtr;
        hit            : integer;
    begin
        myDialog:= GetNewCenteredDialog(AboutID);
        if myDialog <> nil then begin
            ModalDialog(nil,hit);
            DisposDialog(myDialog);
            end
    end;

begin
    theItem := LoWord(mResult);
    case HiWord(mResult) of
        AppleID:                                                { menu Pomme                        }
            if theItem <> 1 then begin
                GetItem(myMenus[AppleMenu], theItem, name);
                theItem := OpenDeskAcc(name)  end
            else ShowAbout;
        FileID:                                                    { menu File                            }
            doneFlag := true;
        EditID:                                                    { menu Edit: uniquement pour DAs    }
            sysEdit := SystemEdit(theItem-1);
        end;
    HiliteMenu(0)
end;


(********************************************************************************)
(*                                 DO MOUSE DOWN                                    *)
(*------------------------------------------------------------------------------*)
(* Gère les clicks souris                                                        *)
(*                                                                                 *)
(* Les paramètres de l'appel :                                                    *)
(* ---------------------------                                                    *)
(*                                                                                 *)
(*        anEvent: l'événement                                                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
Procedure DOMOUSEDOWN (anEvent: eventRecord);
var    whichWind:    windowPtr;
    part:        integer;
begin
    part:= FindWindow(anEvent.where, whichWind);
    case part of
        inMenuBar:        begin
                        AdjustMenus;
                        DoCommand(MenuSelect(anEvent.where))
                        end;
        inSysWindow:    SystemClick(anEvent,whichWind);
        inDrag:         DragWindow(whichWind,anEvent.where,dragRect);
        inGoAway:        if IsAppWindow(whichWind) then
                            doneFlag:= TrackGoAway(whichWind,anEvent.where);
        inContent:        if whichWind <> FrontWindow then
                            SelectWindow(whichWind)
                        else
                            TrackDialog(whichWind,anEvent.where)
        end
end;


(********************************************************************************)
(*                                 ADJUST CURSOR                                    *)
(*------------------------------------------------------------------------------*)
(* Ajuste le curseur suivant région et fenêtre                                    *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
Procedure ADJUSTCURSOR;
begin
    if foreGround and IsAppWindow(FrontWindow) then
        SetCursor(arrow)
end;


(********************************************************************************)
(*                                 CLOSE WINDOWS                                    *)
(*------------------------------------------------------------------------------*)
(* Pour terminer correctement l'application: fermeture de toutes les fenêtres    *)
(* (application et DA's)                                                        *)
(*                                                                                 *)
(********************************************************************************)

{$S Main}
Procedure CLOSEWIND (aWind: windowPtr);
(* ferme une fenêtre                                                            *)
begin
    if IsDAWindow(aWind) then
        CloseDeskAcc(windowPeek(aWind)^.windowKind)
    else if IsAppWindow(aWind) then
        DisposeWindow(aWind)
end;

Procedure CLOSEALLWINDS;
(* ferme toutes les fenêtres                                                    *)
var    window:    windowPtr;
begin
    repeat
        window:= FrontWindow;
        if window <> nil then
            CloseWind(window);
    until window = nil;
end;


Procedure _DataInit;        EXTERNAL;


(********************************************************************************)
(*                         Corps principal du programme                            *)
(*------------------------------------------------------------------------------*)
(* Ouverture des différents managers, Initialisations diverses et boucle prin-    *)
(* cipale typique d'une application Macintosh.                                     *)
(********************************************************************************)

{$S Main}
begin
    UnLoadSeg(@_DataInit);
    MaxApplZone;
    Initialize;
    UnLoadSeg(@Initialize);

    DoneFlag:=false;                                            { flag de terminaison                }
    repeat                                                        { boucle principale typique            }
        if hasWNE then
            eventPending:= WaitNextEvent(everyEvent, myEvent, 0, nil)
                                                                { no sleep, no mouseRgn                }
        else begin
             SystemTask;
             eventPending:= GetNextEvent(everyEvent, myEvent)
        end;
        AdjustCursor;                                            { si ≠ curseurs ou mouseRgn, ici    }
        with myEvent do
            case what of
                osEvt:
                    case BSR(message,24) of
                        suspendResumeMessage:
                            begin
                            foreGround:= BAnd(message,resumeMask) <> 0;
                            end;
                    end;
                keyDown, autoKey:
                    if IsAppWindow(FrontWindow) then begin
                        theChar:= chr(BAnd(message,charCodeMask));
                        IF BAnd(modifiers, cmdKey) <> 0 then
                            DoCommand(MenuKey(theChar))
                    end;
                mouseDown:
                    DoMouseDown(myEvent);
                updateEvt:
                    if IsAppWindow(windowPtr(message)) then begin
                        BeginUpdate(windowPtr(message));
                        if not EmptyRgn(windowPtr(message)^.visRgn) then begin
                            SetPort(windowPtr(message));
                            DrawDialog(windowPtr(message));
                        end;
                        EndUpdate(windowPtr(message))
                    end
                end
    until doneFlag;
    MidiClose(myRefNum);                                                { fermeture MidiShare             }
    SaveWindowPos;
    CloseAllWinds;
    ExitToShell
end.