A.N.A.L.O.G. Magazine 1986 December/86_dec.atr/techpop.act

Text File | 2023-02-26 | 8KB | 1 lines

;TechPop        Wes Philp¢;               160 Sand Pine Road¢;               Indialantic, FL 32903¢;¢DEFINE END="$FE", ;end of preset¢       T="$FD",   ;timbre¢       W="$FC",   ;wait¢       M="$FB",   ;metronome¢       EOL="$FF", ;end-of-list¢       A="$A",B="$B",C="$C",D="$D",¢       E="$E",F="$F",¢       QUIET="0 0 0"¢CARD ARRAY PRESETS(1)=[¢INCLUDE "PRESETS"¢EOL]¢BYTE ARRAY TIMBRES(1)=[¢INCLUDE "TIMBRES"¢EOL]¢;¢; TRAP -------------------------------¢BYTE BRKKEY=$11¢PROC TRAP(BYTE N)¢;stop on BREAK or any OS error¢BRKKEY=0¢RETURN¢;¢; ALERT ------------------------------¢PROC ALERT(BYTE ARRAY STRING)¢PRINTF("%E%S%E",STRING)¢RETURN¢;¢; BUILD_DLI --------------------------¢MODULE¢CARD VDLI_OLD=[0],¢     CLOCK=[0];counts at 4*frame rate¢PROC BUILD_DLI()¢;delay list interrupt servicer¢;increments 16-bit CLOCK¢;¢BYTE ARRAY DLISERVE(1)=[¢$48            ;PHA¢$18            ;CLC¢$A9 $01        ;LDA 1¢$6D]           ;ADC LSB¢BYTE POINTER D1=CLOCK¢BYTE ARRAY D2(1)=[¢$8D]           ;STA LSB¢BYTE POINTER D3=CLOCK¢BYTE ARRAY D4(1)=[¢$90 $03        ;BCC 3¢$EE]           ;INC MSB¢BYTE POINTER D5=CLOCK+1¢BYTE ARRAY D6(1)=[¢$68            ;PLA¢$40]           ;RTI¢;¢BYTE ARRAY MOD_LIST(1)=[¢0 8 16 24]¢BYTE I,¢     NMIEN=$D40E¢CARD VDLI=$200¢BYTE POINTER BP¢CARD POINTER SDLST=560¢;¢;install the DLI service routine¢VDLI_OLD=VDLI¢VDLI=DLISERVE¢NMIEN=$C0 ;DLI and VBI¢;modify the display list¢FOR I=0 TO 3 DO¢  BP=2+MOD_LIST(I)+SDLST^¢  IF MOD_LIST(I)>=2 THEN¢    BP==+2¢  FI¢  BP^==%$80¢OD  ¢BP=SDLST^¢RETURN¢;               ¢; UNBUILD_DLI ------------------------¢PROC UNBUILD_DLI()¢BYTE NMIEN=$D40E¢CARD VDLI=$200     ¢NMIEN=$40 ;VBI only¢VDLI=VDLI_OLD¢GRAPHICS(0)¢RETURN¢;¢; KBD --------------------------------¢BYTE FUNC KBD(BYTE KCHAN,SCHAN)¢;KCHAN=K: channel #¢;SCHAN=S: channel #¢;RETURN:¢;  - operator-entered preset # (0-9)¢;  - $FF no entry¢;  - $FE BREAK¢;  - $FD invalid input¢;  - $FC >¢;  - $FB <¢BYTE CH=$02FC, ;keyboard character¢     N,¢     CR=[155]¢IF BRKKEY=0 THEN¢  ;BREAK key¢  N=$FE¢  BRKKEY=$FF¢ELSEIF CH=$FF THEN¢  ;no entry¢  N=$FF¢ELSE¢  ;read the character¢  N=GETD(KCHAN)¢  IF BRKKEY=0 THEN¢    N=$FE¢    BRKKEY=$FF¢  ELSEIF N='> THEN¢    PUTD(SCHAN,N)¢    N=$FC¢  ELSEIF N='< THEN¢    PUTD(SCHAN,N)¢    N=$FB¢  ELSEIF N>= '0 AND N<='9 THEN¢    PUTD(SCHAN,N)¢    PUTD(SCHAN,CR)¢    N==-'0¢  ELSEIF N=CR THEN ¢    N=$FF ;ignore RETURN¢  ELSE¢    N=$FD ;invalid input¢  FI¢FI¢RETURN(N)¢;¢; FIND_PRESET ------------------------¢CARD FUNC FIND_PRESET(BYTE N)¢;N=preset # (0,1 ...)¢;RETURN:¢;    - preset data address¢;    - $FFFF if not found¢BYTE I,¢     PV¢CARD POINTER P¢P=PRESETS¢I=0¢DO¢  PV=P^ ;LSB only¢  IF I=N AND PV#EOL THEN¢    ;done¢    RETURN(P)¢  ELSEIF PV=EOL THEN¢    ;e.d-of-string found¢    RETURN($FFFF)¢  ELSEIF PV=END THEN¢    I==+1¢  FI¢  P==+2¢OD¢;¢; PREP_TIMBRE ------------------------¢BYTE FUNC PREP_TIMBRE()¢;RETURN: number of timbres defined¢BYTE NT,¢     I,¢     DIST,¢     L¢BYTE POINTER BP¢BP=TIMBRES¢FOR NT=0 TO 254 DO¢  DIST=BP^¢  BP==+2¢  L=BP^¢  BP==+1¢  IF DIST=EOL THEN¢    NT==RSH 1¢    RETURN(NT)¢  ELSEIF L>0 THEN¢    ;fix shapes by ORing distortion¢    DIST==LSH 4¢    FOR I=1 TO L DO¢      BP^==%DIST¢      BP==+1¢    OD¢  FI¢OD¢RETURN(0) ;error return¢;¢; INIT_TIMBRE ------------------------¢PROC INIT_TIMBRE(BYTE N,V,¢                 CARD ARRAY ADDR)¢;N=timbre # (0,1 ...)¢;V=voice (0 or 1)¢;ADDR=addresses of 4 shape strings¢;¢BYTE I,J,¢     L,¢     CHAN¢BYTE POINTER BP,¢             AUDF¢BP=TIMBRES¢IF N#0 THEN¢  ;skip over 2*N timbre arrays¢  J=N+N¢  FOR I=1 TO J DO¢    BP==+2¢    L=BP^¢    BP==+L+1¢  OD¢FI¢;¢FOR I=0 TO 1 DO¢  CHAN=V+V+I ;Atari voice # (0-3)¢  BP==+1¢  AUDF=CHAN+CHAN ;set AUDF¢  AUDF==+$D200¢  AUDF^=BP^¢  BP==+1¢  ADDR(CHAN)=BP ;timbre string address¢  L=BP^         ;timbre string length¢  BP==+L+1¢OD¢RETURN¢;¢; MODULATE ---------------------------¢PROC MODULATE(CARD ARRAY ADDR,¢              BYTE ARRAY OFFSET)¢;ADDR=addresses of 4 shape strings¢;OFFSET=clock offset for voices 0 & 1¢BYTE V,¢     IDX,¢     LSB,¢     I,J,¢     L,¢     CHAN¢BYTE POINTER BP¢BYTE ARRAY AUDC(1)=$D201¢CHAN=0 ;0-3¢FOR V=0 TO 1 DO¢  ;loop over the two voices¢  LSB=CLOCK ;compute the shape index¢  IDX=LSB-OFFSET(V)¢  IF IDX>127 THEN¢    IDX=127¢    OFFSET(V)=LSB+127¢  FI¢  FOR I=0 TO 1 DO¢    ;loop over two channels per voice¢    BP=ADDR(CHAN);timbre string addr¢    L=BP^        ;timbre string length¢    IF L>0 THEN¢      IF IDX<L THEN ;J=MIN(IDX+1,L)¢        J=IDX+1¢      ELSE¢        J=L¢      FI¢      BP==+J¢      J=BP^¢    ELSE¢      J=0 ;no string - quiet¢    FI¢    AUDC(CHAN+CHAN)=J¢    CHAN==+1¢  OD¢OD¢RETURN¢;¢; QUANTUM ----------------------------¢CARD FUNC QUANTUM(CARD R,N)¢;R=metronome (quanta/sec)¢;N=number of quanta to wait¢;RETURN:¢;  clock at end of wait=current+delta¢;  where delta=4*60*N/rate¢CARD DELTA¢IF N>273 THEN¢  N=273 ;overflow will occur¢FI¢DELTA=N*240¢IF DELTA>32767 THEN¢  DELTA==RSH 1¢  R==RSH 1¢FI¢DELTA==/R¢RETURN(DELTA+CLOCK)¢;¢; CONTINUE ---------------------------¢BYTE FUNC CONTINUE(CARD ARRAY P,¢                   INT SPEED,¢                   BYTE N_TIMBRES)¢;P=address of preset¢;SPEED=operator modification to tempo¢;N_TIMBRES=number of timbres defined¢;RETURN:¢;    0 - normal¢;    1 - error¢;¢BYTE INIT=[1],¢     COM,¢     VOICE,¢     I,¢     STATUS¢CARD R,¢     N,¢     NEXT¢INT METRO¢BYTE ARRAY AUD(1)=$D200,¢           OFFSET(2),¢           NULL(1)=[QUIET]¢CARD ARRAY S_ADDR(4)¢CARD POINTER OLD_P=[$FFFF]¢;¢IF INIT#0 THEN¢  ;initialize¢  INIT=0¢  STATUS=0¢  OLD_P=P¢  VOICE=0¢  ZERO(AUD,9)¢  FOR N=0 TO 3 DO¢    S_ADDR(N)=NULL¢  OD¢  CLOCK=0 ¢  NEXT=CLOCK¢FI¢;¢IF NEXT<=CLOCK THEN¢  ;process a command from P array¢  COM=OLD_P^¢  OLD_P==+2¢  IF COM=END THEN¢    ;end of preset¢    INIT=1¢  ELSEIF COM=T THEN¢    ;timbre¢    VOICE==!1 ;flip between 0 and 1¢    I=OLD_P^¢    OLD_P==+2¢    IF I<N_TIMBRES THEN¢      INIT_TIMBRE(I,VOICE,S_ADDR)¢      OFFSET(VOICE)=CLOCK ;LSB only¢    ELSE¢      STATUS=1 ;error¢  FI¢  ELSEIF COM=W THEN¢    ;wait¢    R=METRO+SPEED¢    IF R>32767 THEN ;negative¢      R=2¢    FI¢    N=OLD_P^¢    OLD_P==+2¢    NEXT=QUANTUM(R,N)¢  ELSEIF COM=M THEN¢    ;metronome¢    METRO=OLD_P^¢    OLD_P==+2¢  ELSE¢    STATUS=1 ;error¢  FI¢FI¢IF STATUS=0 THEN¢  ;continue playing¢  MODULATE(S_ADDR,OFFSET)¢ELSE¢  ;error detected¢  INIT=1¢FI¢RETURN(STATUS)¢;¢; TECHPOP ----------------------------¢PROC TECHPOP()¢BYTE CLICK=731,   ;XL keyclick switch¢     RATE=730,    ;XL cursor rep rate¢     CRSINH=$02F0,;cursor inhibit¢     SKCTL=$D20F, ;serial port cntrl¢     SSKCTL=$0232,; ... shadow¢     KCHAN=[7],   ;kbd channel #¢     N,¢     N_TIMBRES¢CARD OLD_ERROR,¢     P=[$FFFF]¢INT SPEED=[0]¢;¢GRAPHICS(0)¢OLD_ERROR=ERROR¢ERROR=TRAP¢CLICK=$FF ;disable XL keyclick¢SKCTL=3¢SSKCTL=3¢DEVICE=0¢CLOSE(KCHAN)¢OPEN(KCHAN,"K:",12,0)¢BUILD_DLI()¢CRSINH=$FF¢PRINTF("%E         TechPop ")¢PRINTF("Synthesizer       wp%E")¢RATE=3 ;fast key auto-repeat¢;¢N_TIMBRES=PREP_TIMBRE();setup timbres¢IF N_TIMBRES=0 THEN¢  ALERT("invalid timbre format")¢FI¢;¢DO¢; N=KBD(KCHAN,SCHAN)¢  N=KBD(KCHAN,0)¢  IF N=$FF THEN¢    ;no input¢  ELSEIF N=$FE THEN¢    ;BREAK key¢    EXIT¢  ELSEIF N=$FD THEN¢    ALERT("?")¢  ELSEIF N=$FC THEN¢    ;speed up¢    SPEED==+1¢  ELSEIF N=$FB THEN¢    ;slow down¢    SPEED==-1¢  ELSEIF N=$FF THEN¢    ;no entry¢  ELSE¢    ;startup a new preset¢    P=FIND_PRESET(N)¢    SPEED=0¢    IF P=$FFFF THEN¢      ALERT("invalid preset")¢    FI¢  FI¢  IF P#$FFFF THEN¢    ;continue playing the preset¢    N=CONTINUE(P,SPEED,N_TIMBRES)¢    IF N#0 THEN¢      ALERT("invalid preset")¢      P=$FFFF¢    FI¢  FI¢OD¢BRKKEY=$FF¢;¢ERROR=OLD_ERROR¢CLICK=0 ;reenable XL keyclick¢UNBUILD_DLI()¢SNDRST()¢RETURN¢¢